The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl -w
use strict;
$| = 1;

# $Id$
# 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 = <<EOPOLICY;
#! /bin/sh

# Testfile: set -DDEBUGGING -DHAVE_COW

ccflags='-DDEBUGGING -DHAVE_COW'
EOPOLICY

my $pobj = Test::Smoke::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'";
}