t/lib/extutils.t

   1 #!./perl -w
   2
   3 print "1..10\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
  16 my $runperl = $^X;
  17
  18 $| = 1;
  19
  20 my $dir = "ext-$$";
  21 my @files;
  22
  23 print "# $dir being created...\n";
  24 mkdir $dir, 0777 or die "mkdir: $!\n";
  25
  26 use File::Spec::Functions;
  27
  28 END {
  29     use File::Path;
  30     print "# $dir being removed...\n";
  31     rmtree($dir);
  32 }
  33
  34 my @names = ("THREE", {name=>"OK4", type=>"PV",},
  35              {name=>"OK5", type=>"PVN",
  36               value=>['"not ok 5\\n\\0ok 5\\n"', 15]},
  37              {name => "FARTHING", type=>"NV"},
  38              {name => "NOT_ZERO", type=>"UV", value=>"~(UV)0"});
  39
  40 my @names_only = map {(ref $_) ? $_->{name} : $_} @names;
  41
  42 my $package = "ExtTest";
  43 ################ Header
  44 my $header = catfile($dir, "test.h");
  45 push @files, "test.h";
  46 open FH, ">$header" or die "open >$header: $!\n";
  47 print FH <<'EOT';
  48 #define THREE 3
  49 #define OK4 "ok 4\n"
  50 #define OK5 1
  51 #define FARTHING 0.25
  52 #define NOT_ZERO 1
  53 EOT
  54 close FH or die "close $header: $!\n";
  55
  56 ################ XS
  57 my $xs = catfile($dir, "$package.xs");
  58 push @files, "$package.xs";
  59 open FH, ">$xs" or die "open >$xs: $!\n";
  60
  61 print FH <<'EOT';
  62 #include "EXTERN.h"
  63 #include "perl.h"
  64 #include "XSUB.h"
  65 EOT
  66
  67 print FH "#include \"test.h\"\n\n";
  68 print FH constant_types(); # macro defs
  69 my $types = {};
  70 foreach (C_constant (undef, "IV", $types, undef, undef, @names) ) {
  71   print FH $_, "\n"; # C constant subs
  72 }
  73 print FH "MODULE = $package             PACKAGE = $package\n";
  74 print FH "PROTOTYPES: ENABLE\n";
  75 print FH XS_constant ($package, $types); # XS for ExtTest::constant
  76 close FH or die "close $xs: $!\n";
  77
  78 ################ PM
  79 my $pm = catfile($dir, "$package.pm");
  80 push @files, "$package.pm";
  81 open FH, ">$pm" or die "open >$pm: $!\n";
  82 print FH "package $package;\n";
  83 print FH "use $];\n";
  84
  85 print FH <<'EOT';
  86
  87 use strict;
  88 use warnings;
  89 use Carp;
  90
  91 require Exporter;
  92 require DynaLoader;
  93 use AutoLoader;
  94 use vars qw ($VERSION @ISA @EXPORT_OK);
  95
  96 $VERSION = '0.01';
  97 @ISA = qw(Exporter DynaLoader);
  98 @EXPORT_OK = qw(
  99 EOT
 100
 101 print FH "\t$_\n" foreach (@names_only);
 102 print FH ");\n";
 103 print FH autoload ($package, $]);
 104 print FH "bootstrap $package \$VERSION;\n1;\n__END__\n";
 105 close FH or die "close $pm: $!\n";
 106
 107 ################ test.pl
 108 my $testpl = catfile($dir, "test.pl");
 109 push @files, "test.pl";
 110 open FH, ">$testpl" or die "open >$testpl: $!\n";
 111
 112 print FH "use $package qw(@names_only);\n";
 113 print FH <<'EOT';
 114
 115 my $three = THREE;
 116 if ($three == 3) {
 117   print "ok 3\n";
 118 } else {
 119   print "not ok 3 # $three\n";
 120 }
 121
 122 print OK4;
 123
 124 $_ = OK5;
 125 s/.*\0//s;
 126 print;
 127
 128 my $farthing = FARTHING;
 129 if ($farthing == 0.25) {
 130   print "ok 6\n";
 131 } else {
 132   print "not ok 6 # $farthing\n";
 133 }
 134
 135 my $not_zero = NOT_ZERO;
 136 if ($not_zero > 0 && $not_zero == ~0) {
 137   print "ok 7\n";
 138 } else {
 139   print "not ok 7 # \$not_zero=$not_zero ~0=" . (~0) . "\n";
 140 }
 141
 142
 143 EOT
 144
 145 close FH or die "close $testpl: $!\n";
 146
 147 ################ dummy Makefile.PL
 148 # Keep the dependancy in the Makefile happy
 149 my $makefilePL = catfile($dir, "Makefile.PL");
 150 push @files, "Makefile.PL";
 151 open FH, ">$makefilePL" or die "open >$makefilePL: $!\n";
 152 close FH or die "close $makefilePL: $!\n";
 153
 154 chdir $dir or die $!; push @INC,  '../../lib';
 155 END {chdir ".." or warn $!};
 156
 157 # Grr. MakeMaker hardwired to write its message to STDOUT.
 158 print "# ";
 159 WriteMakefile(
 160               'NAME'            => $package,
 161               'VERSION_FROM'    => "$package.pm", # finds $VERSION
 162               ($] >= 5.005 ?
 163                (#ABSTRACT_FROM => "$package.pm", # XXX add this
 164                 AUTHOR     => $0) : ())
 165              );
 166 my $makefile = ($^O eq 'VMS' ? 'descrip' : 'Makefile');
 167 my $makefile_ext = ($^O eq 'VMS' ? '.mms' : '');
 168 if (-f "$makefile$makefile_ext") {
 169   print "ok 1\n";
 170 } else {
 171   print "not ok 1\n";
 172 }
 173 my $makefile_rename = ($^O eq 'VMS' ? '.mms' : '.old');
 174 push @files, "$makefile$makefile_rename"; # Renamed by make clean
 175
 176 my $make = $Config{make};
 177
 178 $make = $ENV{MAKE} if exists $ENV{MAKE};
 179
 180 my $makeout;
 181
 182 print "# make = '$make'\n";
 183 $makeout = `$make`;
 184 if ($?) {
 185   print "not ok 2 # $make failed: $?\n";
 186   exit($?);
 187 } else {
 188   print "ok 2\n";
 189 }
 190
 191 my $maketest = "$make test";
 192 print "# make = '$maketest'\n";
 193 $makeout = `$maketest`;
 194 if ($?) {
 195   print "not ok 8 # $make failed: $?\n";
 196 } else {
 197   # Perl babblings
 198   $makeout =~ s/^\s*PERL_DL_NONLAZY=.+?\n//m;
 199
 200   # GNU make babblings
 201   $makeout =~ s/^\w*?make.+?(?:entering|leaving) directory.+?\n//mig;
 202
 203   print $makeout;
 204   print "ok 8\n";
 205 }
 206
 207 my $makeclean = "$make clean";
 208 print "# make = '$makeclean'\n";
 209 $makeout = `$makeclean`;
 210 if ($?) {
 211   print "not ok 9 # $make failed: $?\n";
 212 } else {
 213   print "ok 9\n";
 214 }
 215
 216 foreach (@files) {
 217   unlink $_ or warn "unlink $_: $!";
 218 }
 219
 220 my $fail;
 221 opendir DIR, "." or die "opendir '.': $!";
 222 while (defined (my $entry = readdir DIR)) {
 223   next if $entry =~ /^\.\.?$/;
 224   print "# Extra file '$entry'\n";
 225   $fail = 1;
 226 }
 227 closedir DIR or warn "closedir '.': $!";
 228 if ($fail) {
 229   print "not ok 10\n";
 230 } else {
 231   print "ok 10\n";
 232 }