diff options
| -rw-r--r-- | lib/strict.t | 105 | ||||
| -rw-r--r-- | t/lib/common.pl | 4 |
2 files changed, 10 insertions, 99 deletions
diff --git a/lib/strict.t b/lib/strict.t index 93264ac70e..51e9b7387c 100644 --- a/lib/strict.t +++ b/lib/strict.t @@ -1,112 +1,23 @@ -#!./perl +#!./perl BEGIN { chdir 't' if -d 't'; @INC = '../lib'; $ENV{PERL5LIB} = '../lib'; - require './test.pl'; } -$| = 1; - -my $Is_VMS = $^O eq 'VMS'; -my $Is_MSWin32 = $^O eq 'MSWin32'; -my $Is_NetWare = $^O eq 'NetWare'; -my $i = 0 ; - -my @prgs = () ; - -foreach (sort glob("lib/strict/*")) { - - next if -d || /(~|\.orig|,v)$/; - - open F, "<$_" or die "Cannot open $_: $!\n" ; - while (<F>) { - last if /^__END__/ ; - } - - { - local $/ = undef; - @prgs = (@prgs, split "\n########\n", <F>) ; - } - close F or die "Could not close: $!" ; -} - -undef $/; - -print "1.." . (@prgs + 4) . "\n"; - - -for (@prgs){ - my $switch = ""; - my @temps = () ; - if (s/^\s*-\w+//){ - $switch = $&; - } - my($prog,$expected) = split(/\nEXPECT\n/, $_); - if ( $prog =~ /--FILE--/) { - my(@files) = split(/\n--FILE--\s*([^\s\n]*)\s*\n/, $prog) ; - shift @files ; - die "Internal error test $i didn't split into pairs, got " . - scalar(@files) . "[" . join("%%%%", @files) ."]\n" - if @files % 2 ; - while (@files > 2) { - my $filename = shift @files ; - my $code = shift @files ; - push @temps, $filename ; - open F, ">$filename" or die "Cannot open $filename: $!\n" ; - print F $code ; - close F or die "Could not close: $!" ; - } - shift @files ; - $prog = shift @files ; - } - my $tmpfile = tempfile(); - open TEST, ">$tmpfile" or die "Could not open: $!"; - print TEST $prog,"\n"; - 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` : - `$^X $switch $tmpfile 2>&1`; - my $status = $?; - $results =~ s/\n+$//; - # allow expected output to be written as if $prog is on STDIN - $results =~ s/tmp\d+[A-Z][A-Z]?/-/g; - $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg - $expected =~ s/\n+$//; - my $prefix = ($results =~ s/^PREFIX\n//) ; - my $TODO = $prog =~ m/^#\s*TODO:/; - if ( $results =~ s/^SKIPPED\n//) { - print "$results\n" ; - } - elsif (($prefix and $results !~ /^\Q$expected/) or - (!$prefix and $results ne $expected)){ - if (! $TODO) { - print STDERR "PROG: $switch\n$prog\n"; - print STDERR "EXPECTED:\n$expected\n"; - print STDERR "GOT:\n$results\n"; - } - print "not "; - } - print "ok " . ++$i . ($TODO ? " # TODO" : "") . "\n"; - foreach (@temps) - { unlink $_ if $_ } -} +our $pragma_name = "strict"; +our $local_tests = 4; +require "../t/lib/common.pl"; eval qq(use strict 'garbage'); -print +($@ =~ /^Unknown 'strict' tag\(s\) 'garbage'/) - ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; +like($@, qr/^Unknown 'strict' tag\(s\) 'garbage'/); eval qq(no strict 'garbage'); -print +($@ =~ /^Unknown 'strict' tag\(s\) 'garbage'/) - ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; +like($@, qr/^Unknown 'strict' tag\(s\) 'garbage'/); eval qq(use strict qw(foo bar)); -print +($@ =~ /^Unknown 'strict' tag\(s\) 'foo bar'/) - ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; +like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/); eval qq(no strict qw(foo bar)); -print +($@ =~ /^Unknown 'strict' tag\(s\) 'foo bar'/) - ? "ok ".++$i."\n" : "not ok ".++$i."\t# $@"; +like($@, qr/^Unknown 'strict' tag\(s\) 'foo bar'/); diff --git a/t/lib/common.pl b/t/lib/common.pl index 8680b73328..9167323494 100644 --- a/t/lib/common.pl +++ b/t/lib/common.pl @@ -1,4 +1,4 @@ -# This code is used by lib/warnings.t and lib/feature.t +# This code is used by lib/feature.t, lib/strict.t and lib/warnings.t BEGIN { require './test.pl'; @@ -50,7 +50,7 @@ foreach my $file (@w_files) { undef $/; -plan tests => (scalar(@prgs)-$files); +plan tests => (scalar(@prgs)-$files + ($::local_tests || 0)); for (@prgs){ unless (/\n/) |