#! /usr/bin/perl -w use strict; $| = 1; # $Id: policy.t 763 2004-10-17 16:28:54Z abeltje $ # This file checks to see if the new Test::Smoke::Policy object # does the same as the old way Merijn originaly wrote my $findbin; use File::Basename; BEGIN { $findbin = dirname $0; } use lib $findbin; use TestLib; use Test::Smoke::Util qw( get_config ); use Data::Dumper; use Test::More tests => 3 + 8 + 24 + 2; use_ok( 'Test::Smoke::Policy' ); my $l_policy = <new( \$l_policy ); isa_ok( $pobj, 'Test::Smoke::Policy' ); like( $pobj->{_policy}, q!/^ccflags='-DDEBUGGING -DHAVE_COW'/m!, "Got the right policy" ); my $Policy = $l_policy; # Create a simple configuration (with policy-target) my @config = ( { policy_target => '-DHAVE_COW', args => [ '', '-DHAVE_COW'] }, [ '', '-Dusethreads'], { policy_target => '-DDEBUGGING', args => [ '', '-DDEBUGGING' ] }, ); my @p_conf = ( "", "" ); run_tests( \@p_conf, $Policy, "-Dusedevel", [ ], @config ); # Need more tests! $pobj = Test::Smoke::Policy->new; # default policy $Policy = $pobj->{_policy}; @config = get_config( undef ); @p_conf = ( "", "" ); run_tests( \@p_conf, $Policy, '-Dusedevel', [ ], @config ); # This is a "short-copy" of the mktest.pl sub run_tests { my( $p_conf, $policy, $old_config_args, $substs, $this_test, @tests ) = @_; my $policy_target; if ( ref $this_test eq 'HASH' ) { $policy_target = $this_test->{policy_target}; $this_test = $this_test->{args}; } foreach my $conf ( @$this_test ) { my $config_args = $old_config_args; # Try not to add spurious spaces as it confuses mkovz.pl length $conf and $config_args .= " $conf"; $pobj->reset_rules; $pobj->set_rules( $_ ) for @$substs; my @substs = @$substs; if (defined $policy_target) { # This set of permutations also need to subst inside Policy.sh # somewhere. push @substs, [$policy_target, $conf]; $pobj->set_rules( [$policy_target,$conf] ); } if (@tests) { # Another level of tests run_tests ($p_conf, $policy, $config_args, \@substs, @tests); next; } # Turn the array of instructions on what to substitute into one or # more regexps. Initially we have a list of target/value pairs. my %substs; # First group all the values by target. foreach (@substs) { push @{$substs{$_->[0]}}, $_->[1]; } # use Data::Dumper; print Dumper (\@substs, \%substs); # Then for each target do the substitution. # If more than 1 value wishes to substitute, join them with spaces my $this_policy = $policy; while (my ($target, $values) = each %substs) { #diag( "TRADITIONAL: '$target'-> '@$values' " , # ($this_policy=~/^(ccflags.*)/m) ); unless ($this_policy =~ s/$target/join " ", @$values/seg) { warn "Policy target '$target' failed to match"; } } $pobj->_do_subst; #diag( Dumper $pobj ); my @old = grep ! /^#/ => split /\n/, $this_policy; my @new = grep ! /^#/ => split /\n/, $pobj->{_new_policy}; #diag( Dumper \@old, \@new ); is_deeply( \@new, \@old, "Policy.sh up-to-date: $config_args" ); } } { # Test the new default_Policy my @ccflags = qw( -DPERL_COPY_ON_WRITE -DDEBUGGING ); my $p = Test::Smoke::Policy->new( undef, 0, @ccflags ); isa_ok $p, "Test::Smoke::Policy"; like $p->{_policy}, "/ccflags='@ccflags'/", "Default policy created with '@ccflags'"; }