diff options
Diffstat (limited to 'contrib/perl5/t/comp')
-rwxr-xr-x | contrib/perl5/t/comp/bproto.t | 2 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/colon.t | 2 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/cpp.t | 2 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/proto.t | 34 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/require.t | 31 | ||||
-rwxr-xr-x | contrib/perl5/t/comp/use.t | 2 |
6 files changed, 64 insertions, 9 deletions
diff --git a/contrib/perl5/t/comp/bproto.t b/contrib/perl5/t/comp/bproto.t index 01efb84..70748be 100755 --- a/contrib/perl5/t/comp/bproto.t +++ b/contrib/perl5/t/comp/bproto.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib'; + @INC = '../lib'; } print "1..10\n"; diff --git a/contrib/perl5/t/comp/colon.t b/contrib/perl5/t/comp/colon.t index dee5330..d2c64fe 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'; - unshift @INC, '../lib'; + @INC = '../lib'; } use strict; diff --git a/contrib/perl5/t/comp/cpp.t b/contrib/perl5/t/comp/cpp.t index bbff38c..5b061ee 100755 --- a/contrib/perl5/t/comp/cpp.t +++ b/contrib/perl5/t/comp/cpp.t @@ -4,7 +4,7 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib'; + @INC = '../lib'; } use Config; diff --git a/contrib/perl5/t/comp/proto.t b/contrib/perl5/t/comp/proto.t index ee17088..99dd3ea 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'; - unshift @INC, '../lib'; + @INC = '../lib'; } use strict; -print "1..107\n"; +print "1..122\n"; my $i = 1; @@ -293,6 +293,25 @@ printf "ok %d\n",$i++; ## ## +testing \&a_subx, '\&'; + +sub a_subx (\&) { + print "# \@_ = (",join(",",@_),")\n"; + &{$_[0]}; +} + +sub tmp_sub_2 { printf "ok %d\n",$i++ } +a_subx &tmp_sub_2; + +@array = ( \&tmp_sub_2 ); +eval 'a_subx @array'; +print "not " unless $@; +printf "ok %d\n",$i++; + +## +## +## + testing \&sub_aref, '&\@'; sub sub_aref (&\@) { @@ -466,3 +485,14 @@ sub sreftest (\$$) { sreftest($helem{$i}, $i++); sreftest $aelem[0], $i++; } + +# test prototypes when they are evaled and there is a syntax error +# +for my $p ( "", qw{ () ($) ($@) ($%) ($;$) (&) (&\@) (&@) (%) (\%) (\@) } ) { + no warnings 'redefine'; + my $eval = "sub evaled_subroutine $p { &void *; }"; + eval $eval; + # The /Syntax error/ is seen on OS/390. It's /syntax error/ elsewhere + print "# eval[$eval]\nnot " unless $@ && $@ =~ /[Ss]yntax error/; + print "ok ", $i++, "\n"; +} diff --git a/contrib/perl5/t/comp/require.t b/contrib/perl5/t/comp/require.t index 1d92687..1b0af9f 100755 --- a/contrib/perl5/t/comp/require.t +++ b/contrib/perl5/t/comp/require.t @@ -2,12 +2,21 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, ('.', '../lib'); + @INC = '.'; + push @INC, '../lib'; } # don't make this lexical $i = 1; -print "1..20\n"; +# Tests 21 .. 23 work only with non broken UTF16-as-code implementations, +# i.e. not EBCDIC Perls. +my $Is_EBCDIC = ord('A') == 193 ? 1 : 0; +if ($Is_EBCDIC) { + print "1..20\n"; +} +else { + print "1..23\n"; +} sub do_require { %INC = (); @@ -19,6 +28,8 @@ sub do_require { sub write_file { my $f = shift; open(REQ,">$f") or die "Can't write '$f': $!"; + binmode REQ; + use bytes; print REQ @_; close REQ; } @@ -122,7 +133,21 @@ do "bleah.do"; dofile(); sub dofile { do "bleah.do"; }; print $x; -$i++; + +exit if $Is_EBCDIC; + +# UTF-encoded things +my $utf8 = chr(0xFEFF); + +$i++; do_require(qq(${utf8}print "ok $i\n"; 1;\n)); + +sub bytes_to_utf16 { + my $utf16 = pack("$_[0]*", unpack("C*", $_[1])); + return @_ == 3 && $_[2] ? pack("$_[0]", 0xFEFF) . $utf16 : $utf16; +} + +$i++; do_require(bytes_to_utf16('n', qq(print "ok $i\\n"; 1;\n), 1)); # BE +$i++; do_require(bytes_to_utf16('v', qq(print "ok $i\\n"; 1;\n), 1)); # LE END { 1 while unlink 'bleah.pm'; 1 while unlink 'bleah.do'; } diff --git a/contrib/perl5/t/comp/use.t b/contrib/perl5/t/comp/use.t index 1f5fae3..fb59777 100755 --- a/contrib/perl5/t/comp/use.t +++ b/contrib/perl5/t/comp/use.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib'; + @INC = '../lib'; } print "1..27\n"; |