X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrict.t;h=b5911b37085b7106225611b511501b86dde12c04;hb=dfa4e5d386dd8c5329351699b02085856cdd140e;hp=3a0a2eca8f79ab614e88754165465f38b1873778;hpb=be708cc0141c68546a70e3d19f68ad41bef15add;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/strict.t b/lib/strict.t index 3a0a2ec..b5911b3 100644 --- a/lib/strict.t +++ b/lib/strict.t @@ -13,14 +13,14 @@ my $Is_MSWin32 = $^O eq 'MSWin32'; my $Is_NetWare = $^O eq 'NetWare'; my $tmpfile = "tmp0000"; my $i = 0 ; -1 while -f ++$tmpfile; +1 while -e ++$tmpfile; END { if ($tmpfile) { 1 while unlink $tmpfile; } } my @prgs = () ; -foreach (sort glob($^O eq 'MacOS' ? ":lib::strict:*" : "lib/strict/*")) { +foreach (sort glob($^O eq 'MacOS' ? ":lib:strict:*" : "lib/strict/*")) { - next if /(~|\.orig|,v)$/; + next if -d || /(~|\.orig|,v)$/; open F, "<$_" or die "Cannot open $_: $!\n" ; while () { @@ -31,12 +31,12 @@ foreach (sort glob($^O eq 'MacOS' ? ":lib::strict:*" : "lib/strict/*")) { local $/ = undef; @prgs = (@prgs, split "\n########\n", ) ; } - close F ; + close F or die "Could not close: $!" ; } undef $/; -print "1..", scalar @prgs, "\n"; +print "1.." . (@prgs + 4) . "\n"; for (@prgs){ @@ -59,22 +59,22 @@ for (@prgs){ push @temps, $filename ; open F, ">$filename" or die "Cannot open $filename: $!\n" ; print F $code ; - close F ; + close F or die "Could not close: $!" ; } shift @files ; $prog = shift @files ; $prog =~ s|\./abc|:abc|g if $^O eq 'MacOS'; } - open TEST, ">$tmpfile"; + open TEST, ">$tmpfile" or die "Could not open: $!"; print TEST $prog,"\n"; - close TEST; + close TEST or die "Could not close: $!"; my $results = $Is_MSWin32 ? `.\\perl -I../lib $switch $tmpfile 2>&1` : $^O eq 'NetWare' ? `perl -I../lib $switch $tmpfile 2>&1` : $^O eq 'MacOS' ? `$^X -I::lib -MMac::err=unix $switch $tmpfile` : - `./perl $switch $tmpfile 2>&1`; + `$^X $switch $tmpfile 2>&1`; my $status = $?; $results =~ s/\n+$//; # allow expected output to be written as if $prog is on STDIN @@ -94,7 +94,23 @@ for (@prgs){ print STDERR "GOT:\n$results\n"; print "not "; } - print "ok ", ++$i, "\n"; + print "ok " . ++$i . "\n"; foreach (@temps) { unlink $_ if $_ } } + +eval qq(use strict 'garbage'); +print +($@ =~ /^Unknown 'strict' tag\(s\) 'garbage'/) + ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; + +eval qq(no strict 'garbage'); +print +($@ =~ /^Unknown 'strict' tag\(s\) 'garbage'/) + ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; + +eval qq(use strict qw(foo bar)); +print +($@ =~ /^Unknown 'strict' tag\(s\) 'foo bar'/) + ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; + +eval qq(no strict qw(foo bar)); +print +($@ =~ /^Unknown 'strict' tag\(s\) 'foo bar'/) + ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@";