diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 04:17:15 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 04:17:15 +0000 |
commit | b695f709e8a342e35e482b0437eb6cdacdc58b6b (patch) | |
tree | 2d16192636e6ba806ff7a907f682c74f7705a920 /lib/subs.t | |
parent | d780cd7a0195e946e636d3ee546f6ef4f21d6acc (diff) | |
download | perl-b695f709e8a342e35e482b0437eb6cdacdc58b6b.tar.gz |
The Grand Trek: move the *.t files from t/ to lib/ and ext/.
No doubt I made some mistakes like missed some files or
misnamed some files. The naming rules were more or less:
(1) if the module is from CPAN, follows its ways, be it
t/*.t or test.pl.
(2) otherwise if there are multiple tests for a module
put them in a t/
(3) otherwise if there's only one test put it in Module.t
(4) helper files go to module/ (locale, strict, warnings)
(5) use longer filenames now that we can (but e.g. the
compat-0.6.t and the Text::Balanced test files still
were renamed to be more civil against the 8.3 people)
installperl was updated appropriately not to install the
*.t files or the help files from under lib.
TODO: some helper files still remain under t/ that could
follow their 'masters'. UPDATE: On second thoughts, why
should they. They can continue to live under t/lib, and
in fact the locale/strict/warnings helpers that were moved
could be moved back. This way the amount of non-installable
stuff under lib/ stays smaller.
p4raw-id: //depot/perl@10676
Diffstat (limited to 'lib/subs.t')
-rw-r--r-- | lib/subs.t | 162 |
1 files changed, 162 insertions, 0 deletions
diff --git a/lib/subs.t b/lib/subs.t new file mode 100644 index 0000000000..2f684b41ed --- /dev/null +++ b/lib/subs.t @@ -0,0 +1,162 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + $ENV{PERL5LIB} = '../lib'; +} + +$| = 1; +undef $/; +my @prgs = split "\n########\n", <DATA>; +print "1..", scalar @prgs, "\n"; + +my $Is_VMS = $^O eq 'VMS'; +my $Is_MSWin32 = $^O eq 'MSWin32'; +my $Is_NetWare = $^O eq 'NetWare'; +my $tmpfile = "tmp0000"; +my $i = 0 ; +1 while -f ++$tmpfile; +END { if ($tmpfile) { 1 while unlink $tmpfile} } + +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 ; + } + shift @files ; + $prog = shift @files ; + } + open TEST, ">$tmpfile"; + print TEST $prog,"\n"; + close TEST; + my $results = $Is_VMS ? + `./perl $switch $tmpfile 2>&1` : + $Is_MSWin32 ? + `.\\perl -I../lib $switch $tmpfile 2>&1` : + $Is_NetWare ? + `perl -I../lib $switch $tmpfile 2>&1` : + `./perl $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+/-/g; + $results =~ s/\n%[A-Z]+-[SIWEF]-.*$// if $Is_VMS; # clip off DCL status msg +# bison says 'parse error' instead of 'syntax error', +# various yaccs may or may not capitalize 'syntax'. + $results =~ s/^(syntax|parse) error/syntax error/mig; + $expected =~ s/\n+$//; + my $prefix = ($results =~ s/^PREFIX\n//) ; + if ( $results =~ s/^SKIPPED\n//) { + print "$results\n" ; + } + elsif (($prefix and $results !~ /^\Q$expected/) or + (!$prefix and $results ne $expected)){ + print STDERR "PROG: $switch\n$prog\n"; + print STDERR "EXPECTED:\n$expected\n"; + print STDERR "GOT:\n$results\n"; + print "not "; + } + print "ok ", ++$i, "\n"; + foreach (@temps) + { unlink $_ if $_ } +} + +__END__ + +# Error - not predeclaring a sub +Fred 1,2 ; +sub Fred {} +EXPECT +Number found where operator expected at - line 3, near "Fred 1" + (Do you need to predeclare Fred?) +syntax error at - line 3, near "Fred 1" +Execution of - aborted due to compilation errors. +######## + +# Error - not predeclaring a sub in time +Fred 1,2 ; +use subs qw( Fred ) ; +sub Fred {} +EXPECT +Number found where operator expected at - line 3, near "Fred 1" + (Do you need to predeclare Fred?) +syntax error at - line 3, near "Fred 1" +BEGIN not safe after errors--compilation aborted at - line 4. +######## + +# AOK +use subs qw( Fred) ; +Fred 1,2 ; +sub Fred { print $_[0] + $_[1], "\n" } +EXPECT +3 +######## + +# override a built-in function +use subs qw( open ) ; +open 1,2 ; +sub open { print $_[0] + $_[1], "\n" } +EXPECT +3 +######## + +# override a built-in function, call after definition +use subs qw( open ) ; +sub open { print $_[0] + $_[1], "\n" } +open 1,2 ; +EXPECT +3 +######## + +# override a built-in function, call with () +use subs qw( open ) ; +open (1,2) ; +sub open { print $_[0] + $_[1], "\n" } +EXPECT +3 +######## + +# override a built-in function, call with () after definition +use subs qw( open ) ; +sub open { print $_[0] + $_[1], "\n" } +open (1,2) ; +EXPECT +3 +######## + +--FILE-- abc +Fred 1,2 ; +1; +--FILE-- +use subs qw( Fred ) ; +require "./abc" ; +sub Fred { print $_[0] + $_[1], "\n" } +EXPECT +3 +######## + +# check that it isn't affected by block scope +{ + use subs qw( Fred ) ; +} +Fred 1, 2; +sub Fred { print $_[0] + $_[1], "\n" } +EXPECT +3 |