diff options
Diffstat (limited to 'contrib/perl5/t/comp')
-rwxr-xr-x | contrib/perl5/t/comp/bproto.t | 44 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/colon.t | 2 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/cpp.aux | 4 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/cpp.t | 4 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/proto.t | 51 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/require.t | 85 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/script.t | 3 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/term.t | 8 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/use.t | 79 |
9 files changed, 255 insertions, 25 deletions
diff --git a/contrib/perl5/t/comp/bproto.t b/contrib/perl5/t/comp/bproto.t new file mode 100755 index 0000000..01efb84 --- /dev/null +++ b/contrib/perl5/t/comp/bproto.t @@ -0,0 +1,44 @@ +#!./perl +# +# check if builtins behave as prototyped +# + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} + +print "1..10\n"; + +my $i = 1; + +sub foo {} +my $bar = "bar"; + +sub test_too_many { + eval $_[0]; + print "not " unless $@ =~ /^Too many arguments/; + printf "ok %d\n",$i++; +} + +sub test_no_error { + eval $_[0]; + print "not " if $@; + printf "ok %d\n",$i++; +} + +test_too_many($_) for split /\n/, +q[ defined(&foo, $bar); + undef(&foo, $bar); + uc($bar,$bar); +]; + +test_no_error($_) for split /\n/, +q[ scalar(&foo,$bar); + defined &foo, &foo, &foo; + undef &foo, $bar; + uc $bar,$bar; + grep(not($bar), $bar); + grep(not($bar, $bar), $bar); + grep((not $bar, $bar, $bar), $bar); +]; diff --git a/contrib/perl5/t/comp/colon.t b/contrib/perl5/t/comp/colon.t index d2c64fe..dee5330 100755 --- a/contrib/perl5/t/comp/colon.t +++ b/contrib/perl5/t/comp/colon.t @@ -9,7 +9,7 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib'; } use strict; diff --git a/contrib/perl5/t/comp/cpp.aux b/contrib/perl5/t/comp/cpp.aux index bb93d21..536268a 100755 --- a/contrib/perl5/t/comp/cpp.aux +++ b/contrib/perl5/t/comp/cpp.aux @@ -1,14 +1,10 @@ #!./perl -P -# $RCSfile: cpp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:18 $ - print "1..3\n"; -#this is a comment #define MESS "ok 1\n" print MESS; -#If you capitalize, it's a comment. #ifdef MESS print "ok 2\n"; #else diff --git a/contrib/perl5/t/comp/cpp.t b/contrib/perl5/t/comp/cpp.t index 86e7359..bbff38c 100755 --- a/contrib/perl5/t/comp/cpp.t +++ b/contrib/perl5/t/comp/cpp.t @@ -4,14 +4,14 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib'; } use Config; if ( $^O eq 'MSWin32' or ($Config{'cppstdin'} =~ /\bcppstdin\b/) and ( ! -x $Config{'binexp'} . "/cppstdin") ) { - print "1..0\n"; + print "1..0 # Skip: \$Config{cppstdin} unavailable\n"; exit; # Cannot test till after install, alas. } diff --git a/contrib/perl5/t/comp/proto.t b/contrib/perl5/t/comp/proto.t index db6a9b5..ee17088 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++; +} diff --git a/contrib/perl5/t/comp/require.t b/contrib/perl5/t/comp/require.t index 5c41f5c..1d92687 100755 --- a/contrib/perl5/t/comp/require.t +++ b/contrib/perl5/t/comp/require.t @@ -2,12 +2,12 @@ BEGIN { chdir 't' if -d 't'; - @INC = ('.', '../lib'); + unshift @INC, ('.', '../lib'); } # don't make this lexical $i = 1; -print "1..4\n"; +print "1..20\n"; sub do_require { %INC = (); @@ -23,6 +23,74 @@ sub write_file { close REQ; } +eval {require 5.005}; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { require 5.005 }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { require 5.005; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { + require 5.005 +}; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +# new style version numbers + +eval { require v5.5.630; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { require 10.0.2; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; +print "ok ",$i++,"\n"; + +eval q{ use v5.5.630; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval q{ use 10.0.2; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; +print "ok ",$i++,"\n"; + +my $ver = 5.005_63; +eval { require $ver; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +# check inaccurate fp +$ver = 10.2; +eval { require $ver; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.200\.0 required/; +print "ok ",$i++,"\n"; + +$ver = 10.000_02; +eval { require $ver; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.20 required/; +print "ok ",$i++,"\n"; + +print "not " unless 5.5.1 gt v5.5; +print "ok ",$i++,"\n"; + +{ + use utf8; + print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}"; + print "ok ",$i++,"\n"; + + print "not " unless v7.15 eq "\x{7}\x{f}"; + print "ok ",$i++,"\n"; + + print "not " + unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}"; + print "ok ",$i++,"\n"; +} + # interaction with pod (see the eof) write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); require "bleah.pm"; @@ -45,7 +113,18 @@ do_require "1"; print "# $@\nnot " if $@; print "ok ",$i++,"\n"; -END { unlink 'bleah.pm'; } +# do FILE shouldn't see any outside lexicals +my $x = "ok $i\n"; +write_file("bleah.do", <<EOT); +\$x = "not ok $i\\n"; +EOT +do "bleah.do"; +dofile(); +sub dofile { do "bleah.do"; }; +print $x; +$i++; + +END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; } # ***interaction with pod (don't put any thing after here)*** diff --git a/contrib/perl5/t/comp/script.t b/contrib/perl5/t/comp/script.t index d0c12e9..a9bc47d 100755 --- a/contrib/perl5/t/comp/script.t +++ b/contrib/perl5/t/comp/script.t @@ -6,7 +6,6 @@ print "1..3\n"; $PERL = ($^O eq 'MSWin32') ? '.\perl' : './perl'; $x = `$PERL -le "print 'ok';"`; -if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "print ""ok\n""";`; } if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} @@ -15,12 +14,10 @@ print try 'print "ok\n";'; print try "\n"; close try; $x = `$PERL Comp.script`; -if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. Comp.script`; } if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";} $x = `$PERL <Comp.script`; -if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. <Comp.script`; } if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";} diff --git a/contrib/perl5/t/comp/term.t b/contrib/perl5/t/comp/term.t index eb99680..f079eef 100755 --- a/contrib/perl5/t/comp/term.t +++ b/contrib/perl5/t/comp/term.t @@ -1,10 +1,8 @@ #!./perl -# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:24 $ - # tests that aren't important enough for base.term -print "1..22\n"; +print "1..23\n"; $x = "\\n"; print "#1\t:$x: eq " . ':\n:' . "\n"; @@ -68,3 +66,7 @@ if (ref($a) eq 'HASH') {print "ok 21\n";} else {print "not ok 21\n";} $a = "+{ \$a=>'foo'}"; $a = eval $a; if (ref($a) eq 'HASH') {print "ok 22\n";} else {print "not ok 22\n";} + +$a = "{ 0x01 => 'foo'}->{0x01}"; +$a = eval $a; +if ($a eq 'foo') {print "ok 23\n";} else {print "not ok 23\n";} diff --git a/contrib/perl5/t/comp/use.t b/contrib/perl5/t/comp/use.t index a6ce2a4..1f5fae3 100755 --- a/contrib/perl5/t/comp/use.t +++ b/contrib/perl5/t/comp/use.t @@ -2,12 +2,18 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + unshift @INC, '../lib'; } -print "1..14\n"; +print "1..27\n"; my $i = 1; +eval "use 5.000"; # implicit semicolon +if ($@) { + print STDERR $@,"\n"; + print "not "; +} +print "ok ",$i++,"\n"; eval "use 5.000;"; if ($@) { @@ -44,9 +50,7 @@ unless ($@) { print "ok ",$i++,"\n"; - -use lib; # I know that this module will be there. - +{ use lib } # check that subparse saves pending tokens local $lib::VERSION = 1.0; @@ -99,3 +103,68 @@ print "ok ",$i++,"\n"; print "not " if $INC[0] eq "freda"; print "ok ",$i++,"\n"; + +{ + local $lib::VERSION = 35.36; + eval "use lib v33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib v100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.3/) { + print "not "; + } + print "ok ",$i++,"\n"; + + eval "use lib 33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib 100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.3/) { + print "not "; + } + print "ok ",$i++,"\n"; + + local $lib::VERSION = '35.36'; + eval "use lib v33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib v100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + eval "use lib 33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib 100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + local $lib::VERSION = v35.36; + eval "use lib v33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib v100.105"; + unless ($@ =~ /lib v100\.105 required--this is only v35\.36/) { + print "not "; + } + print "ok ",$i++,"\n"; + + eval "use lib 33.55"; + print "not " if $@; + print "ok ",$i++,"\n"; + + eval "use lib 100.105"; + unless ($@ =~ /lib version 100\.105 required--this is only version 35\.036/) { + print "not "; + } + print "ok ",$i++,"\n"; +} |