t/lib/extutils.t

   1 #!./perl -w
   2
   3 print "1..18\n";
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8 }
   9
  10 use warnings;
  11 use strict;
  12 use ExtUtils::MakeMaker;
  13 use ExtUtils::Constant qw (constant_types C_constant XS_constant autoload);
  14 use Config;
  15 use File::Spec::Functions;
  16 use File::Spec;
  17 # Because were are going to be changing directory before running Makefile.PL
  18 my $perl = File::Spec->rel2abs( $^X );
  19 # ExtUtils::Constant::C_constant uses $^X inside a comment, and we want to
  20 # compare output to ensure that it is the same. We were probably run as ./perl
  21 # whereas we will run the child with the full path in $perl. So make $^X for
  22 # us the same as our child will see.
  23 $^X = $perl;
  24
  25 print "# perl=$perl\n";
  26 my $runperl = "$perl -x \"-I../../lib\"";
  27
  28 $| = 1;
  29
  30 my $dir = "ext-$$";
  31 my @files;
  32
  33 print "# $dir being created...\n";
  34 mkdir $dir, 0777 or die "mkdir: $!\n";
  35
  36
  37 END {
  38     use File::Path;
  39     print "# $dir being removed...\n";
  40     rmtree($dir);
  41 }
  42
  43 my $package = "ExtTest";
  44
  45 my @names = ("FIVE", {name=>"OK6", type=>"PV",},
  46              {name=>"OK7", type=>"PVN",
  47               value=>['"not ok 7\\n\\0ok 7\\n"', 15]},
  48              {name => "FARTHING", type=>"NV"},
  49              {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"},
  50              {name => "CLOSE", type=>"PV", value=>'"*/"',
  51               macro=>["#if 1\n", "#endif\n"]},
  52              {name => "ANSWER", default=>["UV", 42]}, "NOTDEF");
  53
  54 my @names_only = map {(ref $_) ? $_->{name} : $_} @names;
  55
  56 my $types = {};
  57 my $constant_types = constant_types(); # macro defs
  58 my $C_constant = join "\n",
  59   C_constant ($package, undef, "IV", $types, undef, undef, @names);
  60 my $XS_constant = XS_constant ($package, $types); # XS for ExtTest::constant
  61
  62 ################ Header
  63 my $header = catfile($dir, "test.h");
  64 push @files, "test.h";
  65 open FH, ">$header" or die "open >$header: $!\n";
  66 print FH <<'EOT';
  67 #define FIVE 5
  68 #define OK6 "ok 6\n"
  69 #define OK7 1
  70 #define FARTHING 0.25
  71 #define NOT_ZERO 1
  72 #undef NOTDEF
  73 EOT
  74 close FH or die "close $header: $!\n";
  75
  76 ################ XS
  77 my $xs = catfile($dir, "$package.xs");
  78 push @files, "$package.xs";
  79 open FH, ">$xs" or die "open >$xs: $!\n";
  80
  81 print FH <<'EOT';
  82 #include "EXTERN.h"
  83 #include "perl.h"
  84 #include "XSUB.h"
  85 EOT
  86
  87 print FH "#include \"test.h\"\n\n";
  88 print FH $constant_types;
  89 print FH $C_constant, "\n";
  90 print FH "MODULE = $package             PACKAGE = $package\n";
  91 print FH "PROTOTYPES: ENABLE\n";
  92 print FH $XS_constant;
  93 close FH or die "close $xs: $!\n";
  94
  95 ################ PM
  96 my $pm = catfile($dir, "$package.pm");
  97 push @files, "$package.pm";
  98 open FH, ">$pm" or die "open >$pm: $!\n";
  99 print FH "package $package;\n";
 100 print FH "use $];\n";
 101
 102 print FH <<'EOT';
 103
 104 use strict;
 105 use warnings;
 106 use Carp;
 107
 108 require Exporter;
 109 require DynaLoader;
 110 use vars qw ($VERSION @ISA @EXPORT_OK);
 111
 112 $VERSION = '0.01';
 113 @ISA = qw(Exporter DynaLoader);
 114 @EXPORT_OK = qw(
 115 EOT
 116
 117 print FH "\t$_\n" foreach (@names_only);
 118 print FH ");\n";
 119 print FH autoload ($package, $]);
 120 print FH "bootstrap $package \$VERSION;\n1;\n__END__\n";
 121 close FH or die "close $pm: $!\n";
 122
 123 ################ test.pl
 124 my $testpl = catfile($dir, "test.pl");
 125 push @files, "test.pl";
 126 open FH, ">$testpl" or die "open >$testpl: $!\n";
 127
 128 print FH "use strict;\n";
 129 print FH "use $package qw(@names_only);\n";
 130 print FH <<'EOT';
 131
 132 # IV
 133 my $five = FIVE;
 134 if ($five == 5) {
 135   print "ok 5\n";
 136 } else {
 137   print "not ok 5 # $five\n";
 138 }
 139
 140 # PV
 141 print OK6;
 142
 143 # PVN containing embedded \0s
 144 $_ = OK7;
 145 s/.*\0//s;
 146 print;
 147
 148 # NV
 149 my $farthing = FARTHING;
 150 if ($farthing == 0.25) {
 151   print "ok 8\n";
 152 } else {
 153   print "not ok 8 # $farthing\n";
 154 }
 155
 156 # UV
 157 my $not_zero = NOT_ZERO;
 158 if ($not_zero > 0 && $not_zero == ~0) {
 159   print "ok 9\n";
 160 } else {
 161   print "not ok 9 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
 162 }
 163
 164 # Value includes a "*/" in an attempt to bust out of a C comment.
 165 # Also tests custom cpp #if clauses
 166 my $close = CLOSE;
 167 if ($close eq '*/') {
 168   print "ok 10\n";
 169 } else {
 170   print "not ok 10 # \$close='$close'\n";
 171 }
 172
 173 # Default values if macro not defined.
 174 my $answer = ANSWER;
 175 if ($answer == 42) {
 176   print "ok 11\n";
 177 } else {
 178   print "not ok 11 # What do you get if you multiply six by nine? '$answer'\n";
 179 }
 180
 181 # not defined macro
 182 my $notdef = eval { NOTDEF; };
 183 if (defined $notdef) {
 184   print "not ok 12 # \$notdef='$notdef'\n";
 185 } elsif ($@ !~ /Your vendor has not defined ExtTest macro NOTDEF/) {
 186   print "not ok 12 # \$@='$@'\n";
 187 } else {
 188   print "ok 12\n";
 189 }
 190
 191 # not a macro
 192 my $notthere = eval { &ExtTest::NOTTHERE; };
 193 if (defined $notthere) {
 194   print "not ok 13 # \$notthere='$notthere'\n";
 195 } elsif ($@ !~ /NOTTHERE is not a valid ExtTest macro/) {
 196   chomp $@;
 197   print "not ok 13 # \$@='$@'\n";
 198 } else {
 199   print "ok 13\n";
 200 }
 201
 202 EOT
 203
 204 close FH or die "close $testpl: $!\n";
 205
 206 ################ Makefile.PL
 207 # We really need a Makefile.PL because make test for a no dynamic linking perl
 208 # will run Makefile.PL again as part of the "make perl" target.
 209 my $makefilePL = catfile($dir, "Makefile.PL");
 210 push @files, "Makefile.PL";
 211 open FH, ">$makefilePL" or die "open >$makefilePL: $!\n";
 212 print FH <<"EOT";
 213 #!$perl -w
 214 use ExtUtils::MakeMaker;
 215 WriteMakefile(
 216               'NAME'            => "$package",
 217               'VERSION_FROM'    => "$package.pm", # finds \$VERSION
 218               (\$] >= 5.005 ?
 219                (#ABSTRACT_FROM => "$package.pm", # XXX add this
 220                 AUTHOR     => "$0") : ())
 221              );
 222 EOT
 223
 224 close FH or die "close $makefilePL: $!\n";
 225
 226 chdir $dir or die $!; push @INC,  '../../lib';
 227 END {chdir ".." or warn $!};
 228
 229 my @perlout = `$runperl Makefile.PL`;
 230 if ($?) {
 231   print "not ok 1 # $runperl Makefile.PL failed: $?\n";
 232   print "# $_" foreach @perlout;
 233   exit($?);
 234 } else {
 235   print "ok 1\n";
 236 }
 237
 238
 239 my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile');
 240 my $makefile_ext = ($^O eq 'VMS' ? '.mms' : '');
 241 if (-f "$makefile$makefile_ext") {
 242   print "ok 2\n";
 243 } else {
 244   print "not ok 2\n";
 245 }
 246 my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old');
 247 push @files, "$makefile$makefile_rename"; # Renamed by make clean
 248
 249 my $make = $Config{make};
 250
 251 $make = $ENV{MAKE} if exists $ENV{MAKE};
 252
 253 my $makeout;
 254
 255 print "# make = '$make'\n";
 256 $makeout = `$make`;
 257 if ($?) {
 258   print "not ok 3 # $make failed: $?\n";
 259   exit($?);
 260 } else {
 261   print "ok 3\n";
 262 }
 263
 264 if ($Config{usedl}) {
 265   print "ok 4\n";
 266 } else {
 267   push @files, "perl$Config{exe_ext}";
 268   my $makeperl = "$make perl";
 269   print "# make = '$makeperl'\n";
 270   $makeout = `$makeperl`;
 271   if ($?) {
 272     print "not ok 4 # $makeperl failed: $?\n";
 273     exit($?);
 274   } else {
 275     print "ok 4\n";
 276   }
 277 }
 278
 279 my $test = 14;
 280 my $maketest = "$make test";
 281 print "# make = '$maketest'\n";
 282 $makeout = `$maketest`;
 283 if ($?) {
 284   print "not ok $test # $maketest failed: $?\n";
 285 } else {
 286   # echo of running the test script
 287   $makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m;
 288   $makeout =~ s/^MCR.+test.pl\n//mig if $^O eq 'VMS';
 289
 290   # GNU make babblings
 291   $makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig;
 292
 293   # Hopefully gets most make's babblings
 294   # make -f Makefile.aperl perl
 295   $makeout =~ s/^\w*?make.+\sperl[^A-Za-z0-9]*\n//mig;
 296   # make[1]: `perl' is up to date.
 297   $makeout =~ s/^\w*?make.+perl.+?is up to date.*?\n//mig;
 298
 299   print $makeout;
 300   print "ok $test\n";
 301 }
 302 $test++;
 303
 304 my $regen = `$runperl $package.xs`;
 305 if ($?) {
 306   print "not ok $test # $runperl $package.xs failed: $?\n";
 307 } else {
 308   print "ok $test\n";
 309 }
 310 $test++;
 311
 312 my $expect = $constant_types . $C_constant .
 313   "\n#### XS Section:\n" . $XS_constant;
 314
 315 if ($expect eq $regen) {
 316   print "ok $test\n";
 317 } else {
 318   print "not ok $test\n";
 319   # open FOO, ">expect"; print FOO $expect;
 320   # open FOO, ">regen"; print FOO $regen; close FOO;
 321 }
 322 $test++;
 323
 324 my $makeclean = "$make clean";
 325 print "# make = '$makeclean'\n";
 326 $makeout = `$makeclean`;
 327 if ($?) {
 328   print "not ok $test # $make failed: $?\n";
 329 } else {
 330   print "ok $test\n";
 331 }
 332 $test++;
 333
 334 foreach (@files) {
 335   unlink $_ or warn "unlink $_: $!";
 336 }
 337
 338 my $fail;
 339 opendir DIR, "." or die "opendir '.': $!";
 340 while (defined (my $entry = readdir DIR)) {
 341   next if $entry =~ /^\.\.?$/;
 342   print "# Extra file '$entry'\n";
 343   $fail = 1;
 344 }
 345 closedir DIR or warn "closedir '.': $!";
 346 if ($fail) {
 347   print "not ok $test\n";
 348 } else {
 349   print "ok $test\n";
 350 }