X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2Fstrict.t;h=b5911b37085b7106225611b511501b86dde12c04;hb=ec488c7f13c4270af54fc91b6664495b5831b7ec;hp=f03271b536455642b798002037b95edebab56047;hpb=d1e4d418969ad3c5103f26f33d0abea5b1570935;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/strict.t b/lib/strict.t index f03271b..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 () { @@ -36,7 +36,7 @@ foreach (sort glob($^O eq 'MacOS' ? ":lib::strict:*" : "lib/strict/*")) { undef $/; -print "1..", scalar @prgs, "\n"; +print "1.." . (@prgs + 4) . "\n"; for (@prgs){ @@ -65,7 +65,7 @@ for (@prgs){ $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 or die "Could not close: $!"; my $results = $Is_MSWin32 ? @@ -74,7 +74,7 @@ for (@prgs){ `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# $@";