From: Nicholas Clark Date: Sat, 2 Jun 2001 23:57:05 +0000 (+0100) Subject: t/lib/extutils.t X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6d79cad27a2b87dccc1697da50ccc1547477bc4c;p=p5sagit%2Fp5-mst-13.2.git t/lib/extutils.t Message-ID: <20010602235705.Q12698@plum.flirble.org> p4raw-id: //depot/perl@10399 --- diff --git a/lib/ExtUtils/Constant.pm b/lib/ExtUtils/Constant.pm index 59a3126..7bdf585 100644 --- a/lib/ExtUtils/Constant.pm +++ b/lib/ExtUtils/Constant.pm @@ -8,7 +8,8 @@ ExtUtils::Constant - generate XS code to import C header constants use ExtUtils::Constant qw (constant_types C_constant XS_constant); print constant_types(); # macro defs - foreach (C_constant (undef, "IV", undef, undef, undef, @names) ) { + foreach (C_constant ("Foo", undef, "IV", undef, undef, undef, + @names) ) { print $_, "\n"; # C constant subs } print "MODULE = Foo PACKAGE = Foo\n"; @@ -74,7 +75,7 @@ $Text::Wrap::huge = 'overflow'; $Text::Wrap::columns = 80; @ISA = 'Exporter'; -$VERSION = '0.01'; +$VERSION = '0.03'; %EXPORT_TAGS = ( 'all' => [ qw( XS_constant constant_types return_clause memEQ_clause C_stringify @@ -103,15 +104,18 @@ $VERSION = '0.01'; =item C_stringify NAME A function which returns a correctly \ escaped version of the string passed -suitable for C's "" or '' +suitable for C's "" or ''. It will also be valid as a perl "" string. =cut # Hopefully make a happy C identifier. sub C_stringify { local $_ = shift; + return unless defined $_; s/\\/\\\\/g; s/([\"\'])/\\$1/g; # Grr. fix perl mode. + s/\n/\\n/g; # Ensure newlines don't end up in octal + s/\r/\\r/g; s/([[:cntrl:]])/sprintf "\\%03o", ord $1/ge; s/\177/\\177/g; # DEL doesn't seem to be a [:cntrl:] $_; @@ -184,48 +188,90 @@ sub memEQ_clause { return $body; } -=item return_clause VALUE, TYPE, INDENT, MACRO +=item assign INDENT, TYPE, VALUE... + +A function to return a suitable assignment clause. If I is aggregate +(eg I expects both pointer and length) then there should be multiple +Is for the components. + +=cut + +# Hmm. value undef to to NOTDEF? value () to do NOTFOUND? + +sub assign { + my $indent = shift; + my $type = shift; + my $typeset = $XS_TypeSet{$type}; + my $clause; + die "Can't generate code for type $type" unless defined $typeset; + if (ref $typeset) { + die "Type $type is aggregate, but only single value given" + if @_ == 1; + foreach (0 .. $#$typeset) { + $clause .= $indent . "$typeset->[$_] $_[$_];\n"; + } + } else { + die "Aggregate value given for type $type" + if @_ > 1; + $clause .= $indent . "$typeset $_[0];\n"; + } + $clause .= "${indent}return PERL_constant_IS$type;\n"; + return $clause; +} + +=item return_clause VALUE, TYPE, INDENT, MACRO, DEFAULT A function to return a suitable C<#ifdef> clause. I defaults to -I when not defined. If I is aggregate (eg I expects both +I when not defined. If I is aggregate (eg I expects both pointer and length) then I should be a reference to an array of -values in the order expected by the type. +values in the order expected by the type. C will always call +this function with I defined, defaulting to the constant's name. +I if defined is an array reference giving default type and and +value(s) if the clause generated by I doesn't evaluate to true. =cut -sub return_clause { +sub return_clause ($$$$$) { ##ifdef thingy # *iv_return = thingy; # return PERL_constant_ISIV; ##else # return PERL_constant_NOTDEF; ##endif - my ($value, $type, $indent, $macro) = @_; + my ($value, $type, $indent, $macro, $default) = @_; $macro = $value unless defined $macro; $indent = ' ' x ($indent || 6); - die "Macro must not be a reference" if ref $macro; - my $clause = "#ifdef $macro\n"; + my $clause; - my $typeset = $XS_TypeSet{$type}; - die "Can't generate code for type $type" unless defined $typeset; - if (ref $typeset) { - die "Type $type is aggregate, but only single value given" - unless ref $value; - foreach (0 .. $#$typeset) { - $clause .= $indent . "$typeset->[$_] $value->[$_];\n"; - } + ##ifdef thingy + if (ref $macro) { + $clause = $macro->[0]; } else { - die "Aggregate value given for type $type" - if ref $value; - $clause .= $indent . "$typeset $value;\n"; + $clause = "#ifdef $macro\n"; } - return $clause . <<"EOT"; -${indent}return PERL_constant_IS$type; -#else -${indent}return PERL_constant_NOTDEF; -#endif -EOT + + # *iv_return = thingy; + # return PERL_constant_ISIV; + $clause .= assign ($indent, $type, ref $value ? @$value : $value); + + ##else + $clause .= "#else\n"; + + # return PERL_constant_NOTDEF; + if (!defined $default) { + $clause .= "${indent}return PERL_constant_NOTDEF;\n"; + } else { + $clause .= assign ($indent, ref $default ? @$default : $default); + } + + ##endif + if (ref $macro) { + $clause .= $macro->[1]; + } else { + $clause .= "#endif\n"; + } + return $clause } =item params WHAT @@ -248,7 +294,117 @@ sub params { return ($use_iv, $use_nv, $use_pv); } -=item C_constant SUBNAME, DEFAULT_TYPE, TYPES, INDENT, NAMELEN, ITEM... +=item dump_names PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, ITEM... + +An internal function to generate the embedded perl code that will regenerate +the constant subroutines. Parameters are the same as for C_constant, except +that there is no NAMELEN. + +=cut + +sub dump_names { + my ($package, $subname, $default_type, $what, $indent, @items) = @_; + my (@simple, @complex); + foreach (@items) { + my $type = $_->{type} || $default_type; + if ($type eq $default_type and 0 == ($_->{name} =~ tr/A-Za-z0-9_//c) + and !defined ($_->{macro}) and !defined ($_->{value}) + and !defined ($_->{default})) { + # It's the default type, and the name consists only of A-Za-z0-9_ + push @simple, $_->{name}; + } else { + push @complex, $_; + } + } + my $result = <<"EOT"; + /* When generated this function returned values for the list of names given + in this section of perl code. Rather than manually editing these functions + to add or remove constants, which would result in this comment and section + of code becoming inaccurate, we recommend that you edit this section of + code, and use it to regenerate a new set of constant functions which you + then use to replace the originals. + + Regenerate these constant functions by feeding this entire source file to + perl -x + +#!$^X -w +use ExtUtils::Constant qw (constant_types C_constant XS_constant); + +EOT + $result .= 'my $types = {' . join (", ", map "$_ => 1", sort keys %$what) + . "};\n"; + $result .= wrap ("my \@names = (qw(", + " ", join (" ", sort @simple) . ")"); + if (@complex) { + foreach my $item (sort {$a->{name} cmp $b->{name}} @complex) { + my $name = C_stringify $item->{name}; + my ($macro, $value, $default) = @$item{qw (macro value default)}; + my $line = ",\n {name=>\"$name\""; + $line .= ", type=>\"$item->{type}\"" if defined $item->{type}; + if (defined $macro) { + if (ref $macro) { + $line .= ', macro=>["'. join ('", "', map {C_stringify $_} @$macro) + . '"]'; + } else { + $line .= ", macro=>\"" . C_stringify($macro) . "\""; + } + } + if (defined $value) { + if (ref $value) { + $line .= ', value=>["'. join ('", "', map {C_stringify $_} @$value) + . '"]'; + } else { + $line .= ", value=>\"" . C_stringify($value) . "\""; + } + } + if (defined $default) { + if (ref $default) { + $line .= ', default=>["'. join ('", "', map {C_stringify $_} + @$default) + . '"]'; + } else { + $line .= ", default=>\"" . C_stringify($default) . "\""; + } + } + $line .= "}"; + # Ensure that the enclosing C comment doesn't end + # by turning */ into *" . "/ + $line =~ s!\*\/!\*" . "/!gs; + $result .= $line; + } + } + $result .= ");\n"; + + $result .= <<'EOT'; + +print constant_types(); # macro defs +EOT + $package = C_stringify($package); + $result .= + "foreach (C_constant (\"$package\", '$subname', '$default_type', \$types, "; + # The form of the indent parameter isn't defined. (Yet) + if (defined $indent) { + require Data::Dumper; + $Data::Dumper::Terse=1; + chomp ($indent = Data::Dumper::Dumper ($indent)); + $result .= $indent; + } else { + $result .= 'undef'; + } + $result .= ', undef, @names) ) { + print $_, "\n"; # C constant subs +} +print "#### XS Section:\n"; +print XS_constant ("' . $package . '", $types); +__END__ + */ + +'; + + $result; +} + +=item C_constant PACKAGE, SUBNAME, DEFAULT_TYPE, TYPES, INDENT, NAMELEN, ITEM... A function that returns a B of C subroutine definitions that return the value and type of constants when passed the name by the XS wrapper. @@ -274,11 +430,31 @@ the type is aggregate. This defaults to the I if not given. =item macro The C pre-processor macro to use in the C<#ifdef>. This defaults to the -I, and is mainly used if I is an C. +I, and is mainly used if I is an C. If a reference an +array is passed then the first element is used in place of the C<#ifdef> +line, and the second element in place of the C<#endif>. This allows +pre-processor constructions such as + + #if defined (foo) + #if !defined (bar) + ... + #endif + #endif + +to be used to determine if a constant is to be defined. + +=item default + +Default value to use (instead of Cing with "your vendor has not +defined...") to return if the macro isn't defined. Specify a reference to +an array with type followed by value(s). =back -The first 5 argument can safely be given as C, and are mainly used +I is the name of the package, and is only used in comments inside the +generated C code. + +The next 5 arguments can safely be given as C, and are mainly used for recursion. I defaults to C if undefined. I is the type returned by Cs that don't specify their @@ -302,11 +478,12 @@ the generated subroutine is only to be called with a name of this length. =cut sub C_constant { - my ($subname, $default_type, $what, $indent, $namelen, @items) = @_; + my ($package, $subname, $default_type, $what, $indent, $namelen, @items) = @_; + $package ||= 'Foo'; $subname ||= 'constant'; # I'm not using this. But a hashref could be used for full formatting without # breaking this API - $indent ||= 0; + # $indent ||= 0; $default_type ||= 'IV'; if (!ref $what) { # Convert line of the form IV,UV,NV to hash @@ -318,8 +495,18 @@ sub C_constant { foreach (@items) { my $name; if (ref $_) { + # Make a copy which is a normalised version of the ref passed in. $name = $_->{name}; - $what->{$_->{type} ||= $default_type} = 1; + my ($type, $macro, $value, $default) = @$_{qw (type macro value default)}; + $type ||= $default_type; + $what->{$type} = 1; + $_ = {name=>$name, type=>$type}; + + undef $macro if defined $macro and $macro eq $name; + $_->{macro} = $macro if defined $macro; + undef $value if defined $value and $value eq $name; + $_->{value} = $value if defined $value; + $_->{default} = $default if defined $default; } else { $name = $_; $_ = {name=>$_, type=>$default_type}; @@ -340,15 +527,14 @@ sub C_constant { $body .= ", const char **pv_return" if $use_pv; $body .= ") {\n"; - my @names = sort map {$_->{name}} @items; - my $names = << 'EOT' + if (defined $namelen) { + # We are a child subroutine. Print the simple description + my @names = sort map {$_->{name}} @items; + my $names = << 'EOT' /* When generated this function returned values for the list of names given here. However, subsequent manual editing may have added or removed some. EOT - . wrap (" ", " ", join (" ", @names) . " */") . "\n"; - - if (defined $namelen) { - # We are a child subroutine. + . wrap (" ", " ", join (" ", @names) . " */") . "\n"; # Figure out what to switch on. # (RMS, Spread of jump table, Position, Hashref) my @best = (1e38, ~0); @@ -394,12 +580,13 @@ EOT $body .= " case '" . C_stringify ($char) . "':\n"; foreach my $name (sort @{$best->{$char}}) { my $thisone = $items{$name}; - my ($value, $macro) = (@$thisone{qw (value macro)}); + my ($value, $macro, $default) = @$thisone{qw (value macro default)}; $value = $name unless defined $value; $macro = $name unless defined $macro; $body .= memEQ_clause ($name, $offset); # We have checked this offset. - $body .= return_clause ($value, $thisone->{type}, undef, $macro); + $body .= return_clause ($value, $thisone->{type}, undef, $macro, + $default); $body .= " }\n"; } $body .= " break;\n"; @@ -408,7 +595,8 @@ EOT } else { # We are the top level. $body .= " /* Initially switch on the length of the name. */\n"; - $body .= $names; + $body .= dump_names ($package, $subname, $default_type, $what, $indent, + @items); $body .= " switch (len) {\n"; # Need to group names of the same length my @by_length; @@ -420,16 +608,18 @@ EOT $body .= " case $i:\n"; if (@{$by_length[$i]} == 1) { my $thisone = $by_length[$i]->[0]; - my ($name, $value, $macro) = (@$thisone{qw (name value macro)}); + my ($name, $value, $macro, $default) + = @$thisone{qw (name value macro default)}; $value = $name unless defined $value; $macro = $name unless defined $macro; $body .= memEQ_clause ($name); - $body .= return_clause ($value, $thisone->{type}, undef, $macro); + $body .= return_clause ($value, $thisone->{type}, undef, $macro, + $default); $body .= " }\n"; } else { - push @subs, C_constant ("${subname}_$i", $default_type, $what, $indent, - $i, @{$by_length[$i]}); + push @subs, C_constant ($package, "${subname}_$i", $default_type, + $what, $indent, $i, @{$by_length[$i]}); $body .= " return ${subname}_$i (name"; $body .= ", iv_return" if $use_iv; $body .= ", nv_return" if $use_nv; @@ -534,10 +724,12 @@ EOT switch (type) { case PERL_constant_NOTFOUND: sv = sv_2mortal(newSVpvf("%s is not a valid $package macro", s)); + PUSHs(sv); break; case PERL_constant_NOTDEF: sv = sv_2mortal(newSVpvf( "Your vendor has not defined $package macro %s used", s)); + PUSHs(sv); break; EOT @@ -561,6 +753,7 @@ EOT sv = sv_2mortal(newSVpvf( "Unexpected return type %d while processing $package macro %s used", type, s)); + PUSHs(sv); } EOT @@ -568,54 +761,74 @@ EOT } -=item autoload PACKAGE, VERSION +=item autoload PACKAGE, VERSION, AUTOLOADER A function to generate the AUTOLOAD subroutine for the module I I is the perl version the code should be backwards compatible with. -It defaults to the version of perl running the subroutine. +It defaults to the version of perl running the subroutine. If I +is true, the AUTOLOAD subroutine falls back on AutoLoader::AUTOLOAD for all +names that the constant() routine doesn't recognise. =cut +# ' # Grr. syntax highlighters that don't grok pod. + sub autoload { - my ($module, $compat_version) = @_; + my ($module, $compat_version, $autoloader) = @_; $compat_version ||= $]; croak "Can't maintain compatibility back as far as version $compat_version" if $compat_version < 5; - my $tmp = ( $compat_version < 5.006 ? "" : "our \$AUTOLOAD;" ); - return <<"END"; -sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. If a constant is not found then control is passed - # to the AUTOLOAD in AutoLoader. - - my \$constname; - $tmp + my $func = "sub AUTOLOAD {\n" + . " # This AUTOLOAD is used to 'autoload' constants from the constant()\n" + . " # XS function."; + $func .= " If a constant is not found then control is passed\n" + . " # to the AUTOLOAD in AutoLoader." if $autoloader; + + + $func .= "\n\n" + . " my \$constname;\n"; + $func .= + " our \$AUTOLOAD;\n" if ($compat_version >= 5.006); + + $func .= <<"EOT"; (\$constname = \$AUTOLOAD) =~ s/.*:://; croak "&${module}::constant not defined" if \$constname eq 'constant'; my (\$error, \$val) = constant(\$constname); - if (\$error) { - if (\$error =~ /is not a valid/) { - \$AutoLoader::AUTOLOAD = \$AUTOLOAD; +EOT + + if ($autoloader) { + $func .= <<'EOT'; + if ($error) { + if ($error =~ /is not a valid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD; } else { - croak \$error; + croak $error; } } +EOT + } else { + $func .= + " if (\$error) { croak \$error; }\n"; + } + + $func .= <<'END'; { no strict 'refs'; # Fixed between 5.005_53 and 5.005_61 -#XXX if (\$] >= 5.00561) { -#XXX *\$AUTOLOAD = sub () { \$val }; +#XXX if ($] >= 5.00561) { +#XXX *$AUTOLOAD = sub () { $val }; #XXX } #XXX else { - *\$AUTOLOAD = sub { \$val }; + *$AUTOLOAD = sub { $val }; #XXX } } - goto &\$AUTOLOAD; + goto &$AUTOLOAD; } END + return $func; } 1; __END__ diff --git a/t/lib/extutils.t b/t/lib/extutils.t index 6955860..9d54dad 100644 --- a/t/lib/extutils.t +++ b/t/lib/extutils.t @@ -1,6 +1,6 @@ #!./perl -w -print "1..12\n"; +print "1..18\n"; BEGIN { chdir 't' if -d 't'; @@ -16,9 +16,14 @@ use File::Spec::Functions; use File::Spec; # Because were are going to be changing directory before running Makefile.PL my $perl = File::Spec->rel2abs( $^X ); +# ExtUtils::Constant::C_constant uses $^X inside a comment, and we want to +# compare output to ensure that it is the same. We were probably run as ./perl +# whereas we will run the child with the full path in $perl. So make $^X for +# us the same as our child will see. +$^X = $perl; print "# perl=$perl\n"; -my $runperl = "$perl \"-I../../lib\""; +my $runperl = "$perl -x \"-I../../lib\""; $| = 1; @@ -35,15 +40,25 @@ END { rmtree($dir); } +my $package = "ExtTest"; + my @names = ("FIVE", {name=>"OK6", type=>"PV",}, {name=>"OK7", type=>"PVN", value=>['"not ok 7\\n\\0ok 7\\n"', 15]}, {name => "FARTHING", type=>"NV"}, - {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"}); + {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"}, + {name => "CLOSE", type=>"PV", value=>'"*/"', + macro=>["#if 1\n", "#endif\n"]}, + {name => "ANSWER", default=>["UV", 42]}, "NOTDEF"); my @names_only = map {(ref $_) ? $_->{name} : $_} @names; -my $package = "ExtTest"; +my $types = {}; +my $constant_types = constant_types(); # macro defs +my $C_constant = join "\n", + C_constant ($package, undef, "IV", $types, undef, undef, @names); +my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant + ################ Header my $header = catfile($dir, "test.h"); push @files, "test.h"; @@ -54,6 +69,7 @@ print FH <<'EOT'; #define OK7 1 #define FARTHING 0.25 #define NOT_ZERO 1 +#undef NOTDEF EOT close FH or die "close $header: $!\n"; @@ -69,14 +85,11 @@ print FH <<'EOT'; EOT print FH "#include \"test.h\"\n\n"; -print FH constant_types(); # macro defs -my $types = {}; -foreach (C_constant (undef, "IV", $types, undef, undef, @names) ) { - print FH $_, "\n"; # C constant subs -} +print FH $constant_types; +print FH $C_constant, "\n"; print FH "MODULE = $package PACKAGE = $package\n"; print FH "PROTOTYPES: ENABLE\n"; -print FH XS_constant ($package, $types); # XS for ExtTest::constant +print FH $XS_constant; close FH or die "close $xs: $!\n"; ################ PM @@ -94,7 +107,6 @@ use Carp; require Exporter; require DynaLoader; -use AutoLoader; use vars qw ($VERSION @ISA @EXPORT_OK); $VERSION = '0.01'; @@ -113,9 +125,11 @@ my $testpl = catfile($dir, "test.pl"); push @files, "test.pl"; open FH, ">$testpl" or die "open >$testpl: $!\n"; +print FH "use strict;\n"; print FH "use $package qw(@names_only);\n"; print FH <<'EOT'; +# IV my $five = FIVE; if ($five == 5) { print "ok 5\n"; @@ -123,12 +137,15 @@ if ($five == 5) { print "not ok 5 # $five\n"; } +# PV print OK6; +# PVN containing embedded \0s $_ = OK7; s/.*\0//s; print; +# NV my $farthing = FARTHING; if ($farthing == 0.25) { print "ok 8\n"; @@ -136,6 +153,7 @@ if ($farthing == 0.25) { print "not ok 8 # $farthing\n"; } +# UV my $not_zero = NOT_ZERO; if ($not_zero > 0 && $not_zero == ~0) { print "ok 9\n"; @@ -143,17 +161,56 @@ if ($not_zero > 0 && $not_zero == ~0) { print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n"; } +# 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"; +} else { + print "not ok 10 # \$close='$close'\n"; +} + +# Default values if macro not defined. +my $answer = ANSWER; +if ($answer == 42) { + print "ok 11\n"; +} else { + print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n"; +} + +# not defined macro +my $notdef = eval { NOTDEF; }; +if (defined $notdef) { + print "not ok 12 # \$notdef='$notdef'\n"; +} elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) { + print "not ok 12 # \$@='$@'\n"; +} else { + print "ok 12\n"; +} + +# not a macro +my $notthere = eval { &ExtTest::NOTTHERE; }; +if (defined $notthere) { + print "not ok 13 # \$notthere='$notthere'\n"; +} elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) { + chomp $@; + print "not ok 13 # \$@='$@'\n"; +} else { + print "ok 13\n"; +} EOT close FH or die "close $testpl: $!\n"; ################ Makefile.PL -# Keep the dependancy in the Makefile happy +# We really need a Makefile.PL because make test for a no dynamic linking perl +# will run Makefile.PL again as part of the "make perl" target. my $makefilePL = catfile($dir, "Makefile.PL"); push @files, "Makefile.PL"; open FH, ">$makefilePL" or die "open >$makefilePL: $!\n"; print FH <<"EOT"; +#!$perl -w use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => "$package", @@ -219,14 +276,16 @@ if ($Config{usedl}) { } } +my $test = 14; my $maketest = "$make test"; print "# make = '$maketest'\n"; $makeout = `$maketest`; if ($?) { - print "not ok 10 # $maketest failed: $?\n"; + print "not ok $test # $maketest failed: $?\n"; } else { - # Perl babblings + # echo of running the test script $makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m; + $makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS'; # GNU make babblings $makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig; @@ -237,21 +296,40 @@ if ($?) { # make[1]: `perl' is up to date. $makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig; - # echo of running the test script - $makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS'; - print $makeout; - print "ok 10\n"; + print "ok $test\n"; +} +$test++; + +my $regen = `$runperl $package.xs`; +if ($?) { + print "not ok $test # $runperl $package.xs failed: $?\n"; +} else { + print "ok $test\n"; } +$test++; + +my $expect = $constant_types . $C_constant . + "\n#### XS Section:\n" . $XS_constant; + +if ($expect eq $regen) { + print "ok $test\n"; +} else { + print "not ok $test\n"; + # open FOO, ">expect"; print FOO $expect; + # open FOO, ">regen"; print FOO $regen; close FOO; +} +$test++; my $makeclean = "$make clean"; print "# make = '$makeclean'\n"; $makeout = `$makeclean`; if ($?) { - print "not ok 11 # $make failed: $?\n"; + print "not ok $test # $make failed: $?\n"; } else { - print "ok 11\n"; + print "ok $test\n"; } +$test++; foreach (@files) { unlink $_ or warn "unlink $_: $!"; @@ -266,7 +344,7 @@ while (defined (my $entry = readdir DIR)) { } closedir DIR or warn "closedir '.': $!"; if ($fail) { - print "not ok 12\n"; + print "not ok $test\n"; } else { - print "ok 12\n"; + print "ok $test\n"; }