diff options
Diffstat (limited to 'contrib/perl5/t/comp/proto.t')
| -rwxr-xr-x | contrib/perl5/t/comp/proto.t | 51 |
1 files changed, 47 insertions, 4 deletions
diff --git a/contrib/perl5/t/comp/proto.t b/contrib/perl5/t/comp/proto.t index db6a9b508171..ee17088be2e6 100755 --- a/contrib/perl5/t/comp/proto.t +++ b/contrib/perl5/t/comp/proto.t @@ -11,12 +11,12 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib'; } use strict; -print "1..87\n"; +print "1..107\n"; my $i = 1; @@ -384,11 +384,11 @@ print "ok ", $i++, "\n"; print "not " if defined prototype('CORE::system'); print "ok ", $i++, "\n"; -print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$'; +print "# CORE::open => ($p)\nnot " if ($p = prototype('CORE::open')) ne '*;$@'; print "ok ", $i++, "\n"; print "# CORE:Foo => ($p), \$@ => `$@'\nnot " - if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Cannot find an opnumber/; + if defined ($p = eval { prototype('CORE::Foo') or 1 }) or $@ !~ /^Can't find an opnumber/; print "ok ", $i++, "\n"; # correctly note too-short parameter lists that don't end with '$', @@ -417,9 +417,52 @@ print "ok ", $i++, "\n"; # test if the (*) prototype allows barewords, constants, scalar expressions, # globs and globrefs (just as CORE::open() does), all under stricture sub star (*&) { &{$_[1]} } +sub star2 (**&) { &{$_[2]} } +sub BAR { "quux" } +sub Bar::BAZ { "quuz" } my $star = 'FOO'; star FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++; +star(FOO, sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++; star "FOO", sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++; +star("FOO", sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++; star $star, sub { print "ok $i\n" if $_[0] eq 'FOO' }; $i++; +star($star, sub { print "ok $i\n" if $_[0] eq 'FOO' }); $i++; star *FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++; +star(*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }); $i++; star \*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }; $i++; +star(\*FOO, sub { print "ok $i\n" if $_[0] eq \*FOO }); $i++; +star2 FOO, BAR, sub { print "ok $i\n" + if $_[0] eq 'FOO' and $_[1] eq 'BAR' }; $i++; +star2(Bar::BAZ, FOO, sub { print "ok $i\n" + if $_[0] eq 'Bar::BAZ' and $_[1] eq 'FOO' }); $i++; +star2 BAR(), FOO, sub { print "ok $i\n" + if $_[0] eq 'quux' and $_[1] eq 'FOO' }; $i++; +star2(FOO, BAR(), sub { print "ok $i\n" + if $_[0] eq 'FOO' and $_[1] eq 'quux' }); $i++; +star2 "FOO", "BAR", sub { print "ok $i\n" + if $_[0] eq 'FOO' and $_[1] eq 'BAR' }; $i++; +star2("FOO", "BAR", sub { print "ok $i\n" + if $_[0] eq 'FOO' and $_[1] eq 'BAR' }); $i++; +star2 $star, $star, sub { print "ok $i\n" + if $_[0] eq 'FOO' and $_[1] eq 'FOO' }; $i++; +star2($star, $star, sub { print "ok $i\n" + if $_[0] eq 'FOO' and $_[1] eq 'FOO' }); $i++; +star2 *FOO, *BAR, sub { print "ok $i\n" + if $_[0] eq \*FOO and $_[1] eq \*BAR }; $i++; +star2(*FOO, *BAR, sub { print "ok $i\n" + if $_[0] eq \*FOO and $_[1] eq \*BAR }); $i++; +star2 \*FOO, \*BAR, sub { no strict 'refs'; print "ok $i\n" + if $_[0] eq \*{'FOO'} and $_[1] eq \*{'BAR'} }; $i++; +star2(\*FOO, \*BAR, sub { no strict 'refs'; print "ok $i\n" + if $_[0] eq \*{'FOO'} and $_[1] eq \*{'BAR'} }); $i++; + +# test scalarref prototype +sub sreftest (\$$) { + print "ok $_[1]\n" if ref $_[0]; +} +{ + no strict 'vars'; + sreftest my $sref, $i++; + sreftest($helem{$i}, $i++); + sreftest $aelem[0], $i++; +} |