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 12BEGIN { 13 chdir 't' if -d 't'; 14 @INC = '../lib'; 15 # FIXME (or rather FIXh2xs) 16 require Config; 17 if (($Config::Config{'extensions'} !~ m!\bDevel/PPPort\b!) ){ 18 print "1..0 # Skip -- Perl configured without Devel::PPPort module\n"; 19 exit 0; 20 } 21} 22 23# use strict; # we are not really testing this 24use File::Path; # for cleaning up with rmtree() 25use Test::More; 26use File::Spec; 27use File::Find; 28use ExtUtils::Manifest; 29# Don't want its diagnostics getting in the way of ours. 30$ExtUtils::Manifest::Quiet=1; 31my $up = File::Spec->updir(); 32 33my $extracted_program = '../utils/h2xs'; # unix, nt, ... 34 35my $Is_VMS_traildot = 0; 36if ($^O eq 'VMS') { 37 $extracted_program = '[-.utils]h2xs.com'; 38 39 # We have to know if VMS is in UNIX mode. In UNIX mode, trailing dots 40 # should not be present. There are actually two settings that control this. 41 42 $Is_VMS_traildot = 1; 43 my $unix_rpt = 0; 44 my $drop_dot = 0; 45 if (eval 'require VMS::Feature') { 46 $unix_rpt = VMS::Feature::current('filename_unix_report'); 47 $drop_dot = VMS::Feature::current('readdir_dropdotnotype'); 48 } else { 49 my $unix_report = $ENV{'DECC$FILENAME_UNIX_REPORT'} || ''; 50 $unix_rpt = $unix_report =~ /^[ET1]/i; 51 my $drop_dot_notype = $ENV{'DECC$READDIR_DROPDOTNOTYPE'} || ''; 52 $drop_dot = $drop_dot_notype =~ /^[ET1]/i; 53 } 54 $Is_VMS_traildot = 0 if $drop_dot && unix_rpt; 55} 56if (!(-e $extracted_program)) { 57 print "1..0 # Skip: $extracted_program was not built\n"; 58 exit 0; 59} 60# You might also wish to bail out if your perl platform does not 61# do `$^X -e 'warn "Writing h2xst"' 2>&1`; duplicity. 62 63# ok on unix, nt, VMS, ... 64my $dupe = '2>&1'; 65# ok on unix, nt, The extra \" are for VMS 66my $lib = '"-I../lib" "-I../../lib"'; 67# $name should differ from system header file names and must 68# not already be found in the t/ subdirectory for perl. 69my $name = 'h2xst'; 70my $header = "$name.h"; 71my $thisversion = sprintf "%vd", $^V; 72$thisversion =~ s/^v//; 73 74# If this test has failed previously a copy may be left. 75rmtree($name) if -e $name; 76 77my @tests = ( 78"-f -n $name", $], <<"EOXSFILES", 79Defaulting to backwards compatibility with perl $thisversion 80If you intend this module to be compatible with earlier perl versions, please 81specify a minimum perl version with the -b option. 82 83Writing $name/ppport.h 84Writing $name/lib/$name.pm 85Writing $name/$name.xs 86Writing $name/fallback/const-c.inc 87Writing $name/fallback/const-xs.inc 88Writing $name/Makefile.PL 89Writing $name/README 90Writing $name/t/$name.t 91Writing $name/Changes 92Writing $name/MANIFEST 93EOXSFILES 94 95"-f -n $name -b $thisversion", $], <<"EOXSFILES", 96Writing $name/ppport.h 97Writing $name/lib/$name.pm 98Writing $name/$name.xs 99Writing $name/fallback/const-c.inc 100Writing $name/fallback/const-xs.inc 101Writing $name/Makefile.PL 102Writing $name/README 103Writing $name/t/$name.t 104Writing $name/Changes 105Writing $name/MANIFEST 106EOXSFILES 107 108"-f -n $name -b 5.6.1", "5.006001", <<"EOXSFILES", 109Writing $name/ppport.h 110Writing $name/lib/$name.pm 111Writing $name/$name.xs 112Writing $name/fallback/const-c.inc 113Writing $name/fallback/const-xs.inc 114Writing $name/Makefile.PL 115Writing $name/README 116Writing $name/t/$name.t 117Writing $name/Changes 118Writing $name/MANIFEST 119EOXSFILES 120 121"-f -n $name -b 5.5.3", "5.00503", <<"EOXSFILES", 122Writing $name/ppport.h 123Writing $name/lib/$name.pm 124Writing $name/$name.xs 125Writing $name/fallback/const-c.inc 126Writing $name/fallback/const-xs.inc 127Writing $name/Makefile.PL 128Writing $name/README 129Writing $name/t/$name.t 130Writing $name/Changes 131Writing $name/MANIFEST 132EOXSFILES 133 134"\"-X\" -f -n $name -b $thisversion", $], <<"EONOXSFILES", 135Writing $name/lib/$name.pm 136Writing $name/Makefile.PL 137Writing $name/README 138Writing $name/t/$name.t 139Writing $name/Changes 140Writing $name/MANIFEST 141EONOXSFILES 142 143"-f -n $name -b $thisversion $header", $], <<"EOXSFILES", 144Writing $name/ppport.h 145Writing $name/lib/$name.pm 146Writing $name/$name.xs 147Writing $name/fallback/const-c.inc 148Writing $name/fallback/const-xs.inc 149Writing $name/Makefile.PL 150Writing $name/README 151Writing $name/t/$name.t 152Writing $name/Changes 153Writing $name/MANIFEST 154EOXSFILES 155); 156 157my $total_tests = 3; # opening, closing and deleting the header file. 158for (my $i = $#tests; $i > 0; $i-=3) { 159 # 1 test for running it, 1 test for the expected result, and 1 for each file 160 # plus 1 to open and 1 to check for the use in lib/$name.pm and Makefile.PL 161 # And 1 more for our check for "bonus" files, 2 more for ExtUtil::Manifest. 162 # And 1 more to examine const-c.inc contents in tests that use $header. 163 # use the () to force list context and hence count the number of matches. 164 $total_tests += 9 + (() = $tests[$i] =~ /(Writing)/sg); 165 $total_tests++ if $tests[$i-2] =~ / \Q$header\E$/; 166} 167 168plan tests => $total_tests; 169 170ok (open (HEADER, '>', $header), "open '$header'"); 171print HEADER <<HEADER or die $!; 172#define Camel 2 173#define Dromedary 1 174#define Bactrian /* empty */ 175#define Bactrian2 176HEADER 177ok (close (HEADER), "close '$header'"); 178 179while (my ($args, $version, $expectation) = splice @tests, 0, 3) { 180 # h2xs warns about what it is writing hence the (possibly unportable) 181 # 2>&1 dupe: 182 # does it run? 183 my $prog = "$^X $lib $extracted_program $args $dupe"; 184 @result = `$prog`; 185 cmp_ok ($?, "==", 0, "running $prog "); 186 $result = join("",@result); 187 188 #print "# expectation is >$expectation<\n"; 189 #print "# result is >$result<\n"; 190 # Was the output the list of files that were expected? 191 is ($result, $expectation, "running $prog"); 192 193 my (%got); 194 find (sub {$got{$File::Find::name}++ unless -d $_}, $name); 195 196 foreach ($expectation =~ /Writing\s+(\S+)/gm) { 197 if ($^O eq 'VMS') { 198 if ($Is_VMS_traildot) { 199 $_ .= '.' unless $_ =~ m/\./; 200 } 201 $_ = lc($_) unless exists $got{$_}; 202 } 203 ok (-e $_, "check for $_") and delete $got{$_}; 204 } 205 my @extra = keys %got; 206 unless (ok (!@extra, "Are any extra files present?")) { 207 print "# These files are unexpectedly present:\n"; 208 print "# $_\n" foreach sort @extra; 209 } 210 211 chdir ($name) or die "chdir $name failed: $!"; 212 # Aargh. Something wants to load a bit of regexp. And we have to chdir 213 # for ExtUtils::Manifest. Caught between a rock and a hard place, so this 214 # seems the least evil thing to do: 215 push @INC, "../../lib"; 216 my ($missing, $extra) = ExtUtils::Manifest::fullcheck(); 217 is_deeply ($missing, [], "No files in the MANIFEST should be missing"); 218 is_deeply ($extra, [], "and all files present should be in the MANIFEST"); 219 pop @INC; 220 chdir ($up) or die "chdir $up failed: $!"; 221 222 if ($args =~ / \Q$header\E$/) { 223 my $const_c = File::Spec->catfile($name, 'fallback', 'const-c.inc'); 224 my ($found, $diag); 225 if (!open FILE, '<', $const_c) { 226 $diag = "can't open $const_c: $!"; 227 } 228 else { 229 while (<FILE>) { 230 next unless /\b Bactrian 2? \b/x; 231 $found = 1; 232 last; 233 } 234 } 235 ok (!$found, "generated $const_c has no Bactrian(2)"); 236 diag ($diag) if defined $diag; 237 } 238 239 foreach my $leaf (File::Spec->catfile('lib', "$name.pm"), 'Makefile.PL') { 240 my $file = File::Spec->catfile($name, $leaf); 241 if (ok (open (FILE, '<', $file), "open $file")) { 242 my $match = qr/use $version;/; 243 my $found; 244 while (<FILE>) { 245 last if $found = /$match/; 246 } 247 ok ($found, "looking for /$match/ in $file"); 248 close FILE or die "close $file: $!"; 249 } 250 } 251 # clean up 252 rmtree($name); 253} 254 255cmp_ok (unlink ($header), "==", 1, "unlink '$header'") or die "\$! is $!"; 256