# use warnings;
use strict;
use ExtUtils::MakeMaker;
-use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
+use ExtUtils::Constant qw (C_constant autoload);
use File::Spec;
use Cwd;
}
$realtest++;
- # -x is busted on Win32 < 5.6.1, so we emulate it.
- my $regen;
- if( $^O eq 'MSWin32' && $] <= 5.006001 ) {
- open(REGENTMP, ">regentmp") or die $!;
- open(XS, "$package.xs") or die $!;
- my $saw_shebang;
- while(<XS>) {
- $saw_shebang++ if /^#!.*/i ;
- print REGENTMP $_ if $saw_shebang;
- }
- close XS; close REGENTMP;
- $regen = `$runperl regentmp`;
- unlink 'regentmp';
- }
- else {
- $regen = `$runperl -x $package.xs`;
- }
- if ($?) {
- print "not ok $realtest # $runperl -x $package.xs failed: $?\n";
- } else {
- print "ok $realtest - regen\n";
- }
- $realtest++;
-
- if ($expect eq $regen) {
- print "ok $realtest - regen worked\n";
+ if (defined $expect) {
+ # -x is busted on Win32 < 5.6.1, so we emulate it.
+ my $regen;
+ if( $^O eq 'MSWin32' && $] <= 5.006001 ) {
+ open(REGENTMP, ">regentmp") or die $!;
+ open(XS, "$package.xs") or die $!;
+ my $saw_shebang;
+ while(<XS>) {
+ $saw_shebang++ if /^#!.*/i ;
+ print REGENTMP $_ if $saw_shebang;
+ }
+ close XS; close REGENTMP;
+ $regen = `$runperl regentmp`;
+ unlink 'regentmp';
+ }
+ else {
+ $regen = `$runperl -x $package.xs`;
+ }
+ if ($?) {
+ print "not ok $realtest # $runperl -x $package.xs failed: $?\n";
+ } else {
+ print "ok $realtest - regen\n";
+ }
+ $realtest++;
+
+ if ($expect eq $regen) {
+ print "ok $realtest - regen worked\n";
+ } else {
+ print "not ok $realtest - regen worked\n";
+ # open FOO, ">expect"; print FOO $expect;
+ # open FOO, ">regen"; print FOO $regen; close FOO;
+ }
+ $realtest++;
} else {
- print "not ok $realtest - regen worked\n";
- # open FOO, ">expect"; print FOO $expect;
- # open FOO, ">regen"; print FOO $regen; close FOO;
+ for (0..1) {
+ print "ok $realtest # skip no regen or expect for this set of tests\n";
+ $realtest++;
+ }
}
- $realtest++;
my $makeclean = "$make clean";
print "# make = '$makeclean'\n";
}
sub write_and_run_extension {
- my ($name, $items, $export_names, $package, $header, $testfile, $num_tests)
- = @_;
+ my ($name, $items, $export_names, $package, $header, $testfile, $num_tests,
+ $wc_args) = @_;
my $c = tie *C, 'TieOut';
my $xs = tie *XS, 'TieOut';
- ExtUtils::Constant::WriteConstants(C_FH => \*C,
+ ExtUtils::Constant::WriteConstants(C_FH => \*C,
XS_FH => \*XS,
NAME => $package,
NAMES => $items,
+ @$wc_args,
);
my $C_code = $c->read();
untie *C;
untie *XS;
- my $expect = $C_code . "\n#### XS Section:\n" . $XS_code;
+ # Don't check the regeneration code if we specify extra arguments to
+ # WriteConstants. (Fix this to give finer grained control if needed)
+ my $expect;
+ $expect = $C_code . "\n#### XS Section:\n" . $XS_code unless $wc_args;
print "# $name\n# $dir/$subdir being created...\n";
mkdir $subdir, 0777 or die "mkdir: $!\n";
$here = $dummytest;
}
sub end_tests {
- my ($name, $items, $export_names, $header, $testfile) = @_;
+ my ($name, $items, $export_names, $header, $testfile, $args) = @_;
push @tests, [$name, $items, $export_names, $package, $header, $testfile,
- $dummytest - $here];
+ $dummytest - $here, $args];
$dummytest += $after_tests;
}
{name=>$pound, type=>"PV", value=>'"Sterling"', macro=>1},
);
+my @args = undef;
+push @args, [PROXYSUBS => 1] if $] > 5.009002;
+foreach my $args (@args)
{
# Simple tests
start_tests();
# Exporter::Heavy (currently) isn't able to export the last 3 of these:
push @items, @common_items;
- # XXX there are hardwired still.
- my $test_body = <<'EOT';
+ my $test_body = <<"EOT";
+
+my \$test = $dummytest;
+
+EOT
+
+ $test_body .= <<'EOT';
# What follows goes to the temporary file.
# IV
my $five = FIVE;
if ($five == 5) {
- print "ok 5\n";
+ print "ok $test\n";
} else {
- print "not ok 5 # \$five\n";
+ print "not ok $test # \$five\n";
}
+$test++;
# PV
-print OK6;
+if (OK6 eq "ok 6\n") {
+ print "ok $test\n";
+} else {
+ print "not ok $test # \$five\n";
+}
+$test++;
# PVN containing embedded \0s
$_ = OK7;
s/.*\0//s;
+s/7/$test/;
+$test++;
print;
# NV
my $farthing = FARTHING;
if ($farthing == 0.25) {
- print "ok 8\n";
+ print "ok $test\n";
} else {
- print "not ok 8 # $farthing\n";
+ print "not ok $test # $farthing\n";
}
+$test++;
# UV
my $not_zero = NOT_ZERO;
if ($not_zero > 0 && $not_zero == ~0) {
- print "ok 9\n";
+ print "ok $test\n";
} else {
- print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
+ print "not ok $test # \$not_zero=$not_zero ~0=" . (~0) . "\n";
}
+$test++;
# Value includes a "*/" in an attempt to bust out of a C comment.
# Also tests custom cpp #if clauses
my $close = CLOSE;
if ($close eq '*/') {
- print "ok 10\n";
+ print "ok $test\n";
} else {
- print "not ok 10 # \$close='$close'\n";
+ print "not ok $test # \$close='$close'\n";
}
+$test++;
# Default values if macro not defined.
my $answer = ANSWER;
if ($answer == 42) {
- print "ok 11\n";
+ print "ok $test\n";
} else {
- print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
+ print "not ok $test # What do you get if you multiply six by nine? '$answer'\n";
}
+$test++;
# not defined macro
my $notdef = eval { NOTDEF; };
if (defined $notdef) {
- print "not ok 12 # \$notdef='$notdef'\n";
+ print "not ok $test # \$notdef='$notdef'\n";
} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
- print "not ok 12 # \$@='$@'\n";
+ print "not ok $test # \$@='$@'\n";
} else {
- print "ok 12\n";
+ print "ok $test\n";
}
+$test++;
# not a macro
my $notthere = eval { &ExtTest::NOTTHERE; };
if (defined $notthere) {
- print "not ok 13 # \$notthere='$notthere'\n";
+ print "not ok $test # \$notthere='$notthere'\n";
} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
chomp $@;
- print "not ok 13 # \$@='$@'\n";
+ print "not ok $test # \$@='$@'\n";
} else {
- print "ok 13\n";
+ print "ok $test\n";
}
+$test++;
# Truth
my $yes = Yes;
if ($yes) {
- print "ok 14\n";
+ print "ok $test\n";
} else {
- print "not ok 14 # $yes='\$yes'\n";
+ print "not ok $test # $yes='\$yes'\n";
}
+$test++;
# Falsehood
my $no = No;
if (defined $no and !$no) {
- print "ok 15\n";
+ print "ok $test\n";
} else {
- print "not ok 15 # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
+ print "not ok $test # \$no=" . defined ($no) ? "'$no'\n" : "undef\n";
}
+$test++;
# Undef
my $undef = Undef;
unless (defined $undef) {
- print "ok 16\n";
+ print "ok $test\n";
} else {
- print "not ok 16 # \$undef='$undef'\n";
+ print "not ok $test # \$undef='$undef'\n";
}
+$test++;
# invalid macro (chosen to look like a mix up between No and SW)
$notdef = eval { &ExtTest::So };
if (defined $notdef) {
- print "not ok 17 # \$notdef='$notdef'\n";
+ print "not ok $test # \$notdef='$notdef'\n";
} elsif ($@ !~ /^So is not a valid ExtTest macro/) {
- print "not ok 17 # \$@='$@'\n";
+ print "not ok $test # \$@='$@'\n";
} else {
- print "ok 17\n";
+ print "ok $test\n";
}
+$test++;
# invalid defined macro
$notdef = eval { &ExtTest::EW };
if (defined $notdef) {
- print "not ok 18 # \$notdef='$notdef'\n";
+ print "not ok $test # \$notdef='$notdef'\n";
} elsif ($@ !~ /^EW is not a valid ExtTest macro/) {
- print "not ok 18 # \$@='$@'\n";
+ print "not ok $test # \$@='$@'\n";
} else {
- print "ok 18\n";
+ print "ok $test\n";
}
+$test++;
my %compass = (
EOT
}
}
if ($fail) {
- print "not ok 19\n";
+ print "not ok $test\n";
} else {
- print "ok 19\n";
+ print "ok $test\n";
}
+$test++;
EOT
$test_body .= <<"EOT";
my \$rfc1149 = RFC1149;
if (\$rfc1149 ne "$parent_rfc1149") {
- print "not ok 20 # '\$rfc1149' ne '$parent_rfc1149'\n";
+ print "not ok \$test # '\$rfc1149' ne '$parent_rfc1149'\n";
} else {
- print "ok 20\n";
+ print "ok \$test\n";
}
+\$test++;
if (\$rfc1149 != 1149) {
- printf "not ok 21 # %d != 1149\n", \$rfc1149;
+ printf "not ok \$test # %d != 1149\n", \$rfc1149;
} else {
- print "ok 21\n";
+ print "ok \$test\n";
}
+\$test++;
EOT
# test macro=>1
my $open = OPEN;
if ($open eq '/*') {
- print "ok 22\n";
+ print "ok $test\n";
} else {
- print "not ok 22 # \$open='$open'\n";
+ print "not ok $test # \$open='$open'\n";
}
+$test++;
EOT
$dummytest+=18;
- end_tests("Simple tests", \@items, \@export_names, $header, $test_body);
+ end_tests("Simple tests", \@items, \@export_names, $header, $test_body,
+ $args);
}
if ($do_utf_tests) {
projects / p5sagit/p5-mst-13.2.git / commitdiff