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;

# $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<continue()> constructor
{
    my $dft_cfg = <<EOCFG;

-Dusethreads
=
/-DDEBUGGING/

-DDEBUGGING
EOCFG

    my $mktest_out = <<OUT;
Smoking patch 20000

Configuration: -Dusedevel
----------------------------------------------------------------------
PERLIO=stdio	All tests successful.

PERLIO=perlio	All tests successful.

Configuration: -Dusedevel -DDEBUGGING
----------------------------------------------------------------------
PERLIO=stdio	All tests successful.

PERLIO=perlio	All tests successful.

Configuration: -Dusedevel -Dusethreads
----------------------------------------------------------------------
PERLIO=stdio	
OUT

    put_file( $mktest_out, 'mktest.out' );
    my $bcfg = Test::Smoke::BuildCFG->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 );