t/lib/extutils.t

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