lib/h2xs.t

   1 #!./perl -w
   2
   3 # Some quick tests to see if h2xs actually runs and creates files as
   4 # expected.  File contents include date stamps and/or usernames
   5 # hence are not checked.  File existence is checked with -e though.
   6 # This test depends on File::Path::rmtree() to clean up with.
   7 #  - pvhp
   8 #
   9 # We are now checking that the correct use $version; is present in
  10 # Makefile.PL and $module.pm
  11
  12 BEGIN {
  13     chdir 't' if -d 't';
  14     @INC = '../lib';
  15 }
  16
  17 # use strict; # we are not really testing this
  18 use File::Path;  # for cleaning up with rmtree()
  19 use Test;
  20 use File::Spec;
  21
  22 my $extracted_program = '../utils/h2xs'; # unix, nt, ...
  23 if ($^O eq 'VMS') { $extracted_program = '[-.utils]h2xs.com'; }
  24 if ($^O eq 'MacOS') { $extracted_program = '::utils:h2xs'; }
  25 if (!(-e $extracted_program)) {
  26     print "1..0 # Skip: $extracted_program was not built\n";
  27     exit 0;
  28 }
  29 # You might also wish to bail out if your perl platform does not
  30 # do `$^X -e 'warn "Writing h2xst"' 2>&1`; duplicity.
  31
  32 # ok on unix, nt, VMS, ...
  33 my $dupe = '2>&1';
  34 # ok on unix, nt, The extra \" are for VMS
  35 my $lib = '"-I../lib" "-I../../lib"';
  36 # The >&1 would create a file named &1 on MPW (STDERR && STDOUT are
  37 # already merged).
  38 if ($^O eq 'MacOS') {
  39     $dupe = '';
  40     # -x overcomes MPW $Config{startperl} anomaly
  41     $lib = '-x -I::lib: -I:::lib:';
  42 }
  43 # $name should differ from system header file names and must
  44 # not already be found in the t/ subdirectory for perl.
  45 my $name = 'h2xst';
  46 my $header = "$name.h";
  47 my $thisversion = sprintf "%vd", $^V;
  48
  49 my @tests = (
  50 "-f -n $name", $], <<"EOXSFILES",
  51 Defaulting to backwards compatibility with perl $thisversion
  52 If you intend this module to be compatible with earlier perl versions, please
  53 specify a minimum perl version with the -b option.
  54
  55 Writing $name/ppport.h
  56 Writing $name/$name.pm
  57 Writing $name/$name.xs
  58 Writing $name/fallback.c
  59 Writing $name/fallback.xs
  60 Writing $name/Makefile.PL
  61 Writing $name/README
  62 Writing $name/t/1.t
  63 Writing $name/Changes
  64 Writing $name/MANIFEST
  65 EOXSFILES
  66
  67 "-f -n $name -b $thisversion", $], <<"EOXSFILES",
  68 Writing $name/ppport.h
  69 Writing $name/$name.pm
  70 Writing $name/$name.xs
  71 Writing $name/fallback.c
  72 Writing $name/fallback.xs
  73 Writing $name/Makefile.PL
  74 Writing $name/README
  75 Writing $name/t/1.t
  76 Writing $name/Changes
  77 Writing $name/MANIFEST
  78 EOXSFILES
  79
  80 "-f -n $name -b 5.6.1", "5.006001", <<"EOXSFILES",
  81 Writing $name/ppport.h
  82 Writing $name/$name.pm
  83 Writing $name/$name.xs
  84 Writing $name/fallback.c
  85 Writing $name/fallback.xs
  86 Writing $name/Makefile.PL
  87 Writing $name/README
  88 Writing $name/t/1.t
  89 Writing $name/Changes
  90 Writing $name/MANIFEST
  91 EOXSFILES
  92
  93 "-f -n $name -b 5.5.3", "5.00503", <<"EOXSFILES",
  94 Writing $name/ppport.h
  95 Writing $name/$name.pm
  96 Writing $name/$name.xs
  97 Writing $name/fallback.c
  98 Writing $name/fallback.xs
  99 Writing $name/Makefile.PL
 100 Writing $name/README
 101 Writing $name/t/1.t
 102 Writing $name/Changes
 103 Writing $name/MANIFEST
 104 EOXSFILES
 105
 106 "\"-X\" -f -n $name -b $thisversion", $], <<"EONOXSFILES",
 107 Writing $name/$name.pm
 108 Writing $name/Makefile.PL
 109 Writing $name/README
 110 Writing $name/t/1.t
 111 Writing $name/Changes
 112 Writing $name/MANIFEST
 113 EONOXSFILES
 114
 115 "-f -n $name $header -b $thisversion", $], <<"EOXSFILES",
 116 Writing $name/ppport.h
 117 Writing $name/$name.pm
 118 Writing $name/$name.xs
 119 Writing $name/fallback.c
 120 Writing $name/fallback.xs
 121 Writing $name/Makefile.PL
 122 Writing $name/README
 123 Writing $name/t/1.t
 124 Writing $name/Changes
 125 Writing $name/MANIFEST
 126 EOXSFILES
 127 );
 128
 129 my $total_tests = 3; # opening, closing and deleting the header file.
 130 for (my $i = $#tests; $i > 0; $i-=3) {
 131   # 1 test for running it, 1 test for the expected result, and 1 for each file
 132   # plus 1 to open and 1 to check for the use in $name.pm and Makefile.PL
 133   # use the () to force list context and hence count the number of matches.
 134   $total_tests += 6 + (() = $tests[$i] =~ /(Writing)/sg);
 135 }
 136
 137 plan tests => $total_tests;
 138
 139 ok (open (HEADER, ">$header"));
 140 print HEADER <<HEADER or die $!;
 141 #define Camel 2
 142 #define Dromedary 1
 143 HEADER
 144 ok (close (HEADER));
 145
 146 while (my ($args, $version, $expectation) = splice @tests, 0, 3) {
 147   # h2xs warns about what it is writing hence the (possibly unportable)
 148   # 2>&1 dupe:
 149   # does it run?
 150   my $prog = "$^X $lib $extracted_program $args $dupe";
 151   @result = `$prog`;
 152   ok ($?, 0, "running $prog ");
 153   $result = join("",@result);
 154
 155   # accomodate MPW # comment character prependage
 156   if ($^O eq 'MacOS') {
 157     $result =~ s/#\s*//gs;
 158   }
 159
 160   #print "# expectation is >$expectation<\n";
 161   #print "# result is >$result<\n";
 162   # Was the output the list of files that were expected?
 163   ok ($result, $expectation, "running $prog");
 164
 165   foreach ($expectation =~ /Writing\s+(\S+)/gm) {
 166     if ($^O eq 'MacOS') {
 167       $_ = ':' . join(':',split(/\//,$_));
 168       $_ =~ s/$name:t:1.t/$name:t\/1.t/; # is this an h2xs bug?
 169     }
 170     ok (-e $_, 1, "$_ missing");
 171   }
 172
 173   foreach my $leaf ("$name.pm", 'Makefile.PL') {
 174     my $file = File::Spec->catfile($name, $leaf);
 175     if (ok (open (FILE, $file), 1, "open $file")) {
 176       my $match = qr/use $version;/;
 177       my $found;
 178       while (<FILE>) {
 179         last if $found = /$match/;
 180       }
 181       ok ($found, 1, "looking for /$match/ in $file");
 182       close FILE or die "close $file: $!";
 183     }
 184   }
 185   # clean up
 186   rmtree($name);
 187 }
 188
 189 ok (unlink ($header), 1, $!);