#! /usr/bin/perl -w use strict; # $Id: buildcfg.t 763 2004-10-17 16:28:54Z abeltje $ use Test::More tests => 81; my $verbose = 0; my $findbin; use File::Basename; BEGIN { $findbin = dirname $0; } use lib $findbin; use TestLib; use_ok "Test::Smoke::BuildCFG"; { # Start with a basic configuration my $dft_cfg = <<__EOCFG__; -Uuseperlio = -Duseithreads = /-DDEBUGGING/ -DDEBUGGING __EOCFG__ my $dft_sect = [ [ '', '-Uuseperlio' ], [ '', '-Duseithreads' ], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING'] }, ]; my $bcfg = Test::Smoke::BuildCFG->new( \$dft_cfg => { v => $verbose } ); isa_ok $bcfg, "Test::Smoke::BuildCFG"; is_deeply $bcfg->{_sections}, $dft_sect, "Parse a configuration"; is $bcfg->as_string, $dft_cfg, "as_string()"; } { # Check that order within sections is honored my $dft_cfg = <<__EOCFG__; -Duseithreads = -Uuseperlio -Duse64bitint = /-DDEBUGGING/ -DDEBUGGING __EOCFG__ my $dft_sect = [ [ '', '-Duseithreads' ], [ '-Uuseperlio', '', '-Duse64bitint' ], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING'] }, ]; my $bcfg = Test::Smoke::BuildCFG->new( \$dft_cfg => { v => $verbose } ); is_deeply $bcfg->{_sections}, $dft_sect, "Section-order kept"; my $first = ( $bcfg->configurations )[0]; isa_ok( $first, 'Test::Smoke::BuildCFG::Config'); is( "$first", $first->[0], "as_string: $first->[0]" ); foreach my $config ( $bcfg->configurations ) { if ( ($config->policy)[0]->[1] ) { ok( $config->has_arg( '-DDEBUGGING' ), "has_arg(-DDEBUGGING)" ); like( "$config", '/-DDEBUGGING/', "'$config' has -DDEBUGGING" ); } else { ok( !$config->has_arg( '-DDEBUGGING' ), "! has_arg(-DDEBUGGING)" ); unlike( "$config", '/-DDEBUGGING/', "'$config' has no -DDEBUGGING" ); } ok( $config->args_eq( "$config" ), "Stringyfied: args_eq($config)" ); } is $bcfg->as_string, $dft_cfg, "as_string()"; } { # Check that empty lines at the end of sections are honored my $dft_cfg = <<__EOCFG__; -Duseithreads = /-DDEBUGGING/ -DDEBUGGING __EOCFG__ my $dft_sect = [ [ '-Duseithreads', '' ], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING'] }, ]; my $bcfg = Test::Smoke::BuildCFG->new( \$dft_cfg => { v => $verbose } ); is_deeply $bcfg->{_sections}, $dft_sect, "Empty lines at end of section kept"; my $first = ( $bcfg->configurations )[0]; isa_ok( $first, 'Test::Smoke::BuildCFG::Config'); is( "$first", $first->[0], "as_string: $first->[0]" ); foreach my $config ( $bcfg->configurations ) { if ( ($config->policy)[0]->[1] ) { ok( $config->has_arg( '-DDEBUGGING' ), "has_arg(-DDEBUGGING)" ); like( "$config", '/-DDEBUGGING/', "'$config' has -DDEBUGGING" ); } else { ok( !$config->has_arg( '-DDEBUGGING' ), "! has_arg(-DDEBUGGING)" ); unlike( "$config", '/-DDEBUGGING/', "'$config' has no -DDEBUGGING" ); } ok( $config->args_eq( "$config" ), "Stringyfied: args_eq($config)" ); } is $bcfg->as_string, $dft_cfg, "as_string()" } { # Check that empty sections are skipped my $dft_cfg = <<__EOCFG__; # This is an empty section # It really is, although it's got an empty (non comment) line = -Duseithreads == -Uuseperlio -Duse64bitint = /-DDEBUGGING/ -DDEBUGGING __EOCFG__ my $dft_sect = [ [ '', '-Duseithreads' ], [ '-Uuseperlio', '', '-Duse64bitint' ], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING'] }, ]; my $bcfg = Test::Smoke::BuildCFG->new( \$dft_cfg => { v => $verbose } ); is_deeply $bcfg->{_sections}, $dft_sect, "Empty sections are skipped"; ( my $as_string = $dft_cfg ) =~ s/^[^=]*=\n//; $as_string =~ s/^=.*/=/mg; is $bcfg->as_string, $as_string, "as_string()"; } { # This is to test the default configuration my $dft_sect = [ [ '', '-Duseithreads'], [ '-Uuseperlio', '', qw(-Duse64bitint -Duselongdouble -Dusemorebits) ], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING'] }, ]; my $bcfg = Test::Smoke::BuildCFG->new( undef, { v => $verbose } ); is_deeply $bcfg->{_sections}, $dft_sect, "Default configuration"; } { # Check the new ->policy_targets() method my $dft_cfg = <<__EOCFG__; /-DPERL_COPY_ON_WRITE/ -DPERL_COPY_ON_WRITE = -Duseithreads = /-DDEBUGGING/ -DDEBUGGING __EOCFG__ my $dft_sect = [ { policy_target => '-DPERL_COPY_ON_WRITE', args => [ '', '-DPERL_COPY_ON_WRITE'] }, [ '', '-Duseithreads' ], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING'] }, ]; my $bcfg = Test::Smoke::BuildCFG->new( \$dft_cfg => { v => $verbose } ); is_deeply [ $bcfg->policy_targets ], [qw( -DPERL_COPY_ON_WRITE -DDEBUGGING )], "Policy targets..."; is $bcfg->as_string, $dft_cfg, "as_string()"; } # Now we need to test the C constructor { my $dft_cfg = <continue( 'mktest.out', \$dft_cfg ); isa_ok( $bcfg, 'Test::Smoke::BuildCFG' ); my @not_seen; push @not_seen, "$_" for $bcfg->configurations; is_deeply( \@not_seen, ["-Dusedevel -Dusethreads", "-Dusedevel -Dusethreads -DDEBUGGING" ], "The right configs are left for continue" ); 1 while unlink 'mktest.out'; } # Test the interface to Test::Smoke::BuildCFG::Config { my $cfgline = q[-Duseithreads -Dcc='gcc']; my $bcfg = Test::Smoke::BuildCFG::new_configuration( $cfgline ); isa_ok $bcfg, 'Test::Smoke::BuildCFG::Config'; is "$bcfg", $cfgline, "stringify($cfgline)"; ok $bcfg->has_arg( "-Dcc='gcc'" ), "has -Dcc='gcc'"; ok $bcfg->has_arg( "-Duseithreads" ), "has -Duseithreads"; ok $bcfg->has_arg( "-Dcc='gcc'", "-Duseithreads" ), "has both"; ok $bcfg->any_arg( "-Dcc='gcc'", "-Duseithreads" ), "has either"; ok $bcfg->args_eq( $cfgline ), "args_eq()"; is $bcfg->rm_arg( "-Dcc='gcc'" ), "-Duseithreads", "rm_arg()"; is "$bcfg", "-Duseithreads", "stringify()"; } { my $bcfg = Test::Smoke::BuildCFG::new_configuration( "" ); isa_ok $bcfg, "Test::Smoke::BuildCFG::Config"; is "$bcfg", "", "stringify empty"; ok !$bcfg->has_arg( '-Duseithreads' ), "hasnt_arg(-Duseithreads)"; } { my $cfg = q/-Dusedevel -Dprefix="sys$login:[perl59x]"/; my $bcfg = Test::Smoke::BuildCFG::new_configuration( $cfg ); isa_ok $bcfg, 'Test::Smoke::BuildCFG::Config'; is $bcfg->vms, q/-"Dusedevel" -"Dprefix=sys$login:[perl59x]"/, "check vms cmdline"; } package Test::BCFGTester; use strict; use Test::Builder; use base 'Exporter'; use vars qw( $VERSION @EXPORT ); $VERSION = '0.001'; @EXPORT = qw( &config_ok );