X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Frun%2Ffresh_perl.t;h=980f5e53be526694db2e4cee7ba30708bdec6d1a;hb=cf2649810f00335bd657355d81bcc9384a620135;hp=41aa1eca58a9cedf7a4305574009938b4d3e6055;hpb=c64c7340e1f13afc97ec321c9d90ab6478848f76;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index 41aa1ec..980f5e5 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -4,20 +4,9 @@ # Instead, put the test in the appropriate test file and use the # fresh_perl_is()/fresh_perl_like() functions in t/test.pl. -# This is for tests that will normally cause segfaults, and other nasty +# This is for tests that used to abnormally cause segfaults, and other nasty # errors that might kill the interpreter and for some reason you can't # use an eval(). -# -# New tests are added to the bottom. For example. -# -# ######## perlbug ID 20020831.001 -# ($a, b) = (1,2) -# EXPECT -# Can't modify constant item in list assignment - at line 1 -# -# to test that the code "($a, b) = (1,2)" causes the appropriate syntax -# error, rather than just segfaulting as reported in perlbug ID -# 20020831.001 BEGIN { chdir 't' if -d 't'; @@ -52,6 +41,13 @@ foreach my $prog (@prgs) { my($prog,$expected) = split(/\nEXPECT\n/, $raw_prog); + if ($prog =~ /^\# SKIP: (.+)/m) { + if (eval $1) { + ok(1, "Skip: $1"); + next; + } + } + $expected =~ s/\n+$//; fresh_perl_is($prog, $expected, { switches => [$switch] }, $name); @@ -93,9 +89,9 @@ $x=2;$y=3;$x<$y ? $x : $y += 23;print $x; EXPECT 25 ######## -eval {sub bar {print "In bar";}} +eval 'sub bar {print "In bar"}'; ######## -system './perl -ne "print if eof" /dev/null' +system './perl -ne "print if eof" /dev/null' unless $^O eq 'MacOS' ######## chop($file = ); ######## @@ -107,11 +103,6 @@ print $aa; EXPECT 12345 ######## -%@x=0; -EXPECT -Can't modify hash dereference in repeat (x) at - line 1, near "0;" -Execution of - aborted due to compilation errors. -######## $_="foo"; printf(STDOUT "%s\n", $_); EXPECT @@ -282,7 +273,7 @@ print "ok\n" if ("\0" lt "\xFF"); EXPECT ok ######## -open(H,'run/fresh_perl.t'); # must be in the 't' directory +open(H,$^O eq 'MacOS' ? ':run:fresh_perl.t' : 'run/fresh_perl.t'); # must be in the 't' directory stat(H); print "ok\n" if (-e _ and -f _ and -r _); EXPECT @@ -358,7 +349,6 @@ print "you die joe!\n" unless "@x" eq 'x y z'; ######## /(?{"{"})/ # Check it outside of eval too EXPECT -Sequence (?{...}) not terminated or not {}-balanced at - line 1, within pattern Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1. ######## /(?{"{"}})/ # Check it outside of eval too @@ -520,7 +510,7 @@ else { if ($x == 0) { print "" } else { print $x } } EXPECT -Use of uninitialized value in numeric eq (==) at - line 4. +Use of uninitialized value $x in numeric eq (==) at - line 4. ######## $x = sub {}; foo(); @@ -573,7 +563,7 @@ EOT EXPECT ok ######## -# This test is here instead of pragma/locale.t because +# This test is here instead of lib/locale.t because # the bug depends on in the internal state of the locale # settings and pragma/locale messes up that state pretty badly. # We need a "fresh run". @@ -591,7 +581,7 @@ $have_setlocale = 0 if $@; $have_setlocale = 0 if (($^O eq 'MSWin32' || $^O eq 'NetWare') && $Config{cc} =~ /^(cl|gcc)/i); exit(0) unless $have_setlocale; my @locales; -if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a|")) { +if (-x "/usr/bin/locale" && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) { while() { chomp; push(@locales, $_); @@ -609,9 +599,11 @@ for (@locales) { } EXPECT ######## +# [ID 20001202.002] and change #8066 added 'at -e line 1'; +# reversed again as a result of [perl #17763] die qr(x) EXPECT -(?-xism:x) at - line 1. +(?-xism:x) ######## # 20001210.003 mjd@plover.com format REMITOUT_TOP = @@ -679,18 +671,6 @@ OK EXPECT ok ######## -# Bug 20010422.005 -{s//${}/; //} -EXPECT -syntax error at - line 2, near "${}" -Execution of - aborted due to compilation errors. -######## -# Bug 20010528.007 -"\x{" -EXPECT -Missing right brace on \x{} at - line 2, within string -Execution of - aborted due to compilation errors. -######## my $foo = Bar->new(); my @dst; END { @@ -708,26 +688,6 @@ sub DESTROY { } EXPECT Bar=ARRAY(0x...) -######## -######## found by Markov chain stress testing -eval "a.b.c.d.e.f;sub" -EXPECT - -######## perlbug ID 20010831.001 -($a, b) = (1, 2); -EXPECT -Can't modify constant item in list assignment at - line 1, near ");" -Execution of - aborted due to compilation errors. -######## tying a bareword causes a segfault in 5.6.1 -tie FOO, "Foo"; -EXPECT -Can't modify constant item in tie at - line 1, near ""Foo";" -Execution of - aborted due to compilation errors. -######## undefing constant causes a segfault in 5.6.1 [ID 20010906.019] -undef foo; -EXPECT -Can't modify constant item in undef operator at - line 1, near "foo;" -Execution of - aborted due to compilation errors. ######## (?{...}) compilation bounces on PL_rs -0 { @@ -737,11 +697,6 @@ Execution of - aborted due to compilation errors. BEGIN { print "ok\n" } EXPECT ok -######## read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054] -read($bla, FILE, 1); -EXPECT -Can't modify constant item in read at - line 1, near "1)" -Execution of - aborted due to compilation errors. ######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155] # This only happens if the filename is 11 characters or less. $foo = \-f "blah"; @@ -760,7 +715,7 @@ EXPECT 123456789 ######## [ID 20020104.007] "coredump on dbmclose" package Foo; -eval { dbmclose %h }; # not all places have dbm* functions +eval { require AnyDBM_File }; # not all places have dbm* functions if ($@) { print "ok\n"; exit 0; @@ -788,3 +743,132 @@ package main; $test = Foo->new(); # must be package var EXPECT ok +######## example from Camel 5, ch. 15, pp.406 (with my) +# SKIP: ord "A" == 193 # EBCDIC +use strict; +use utf8; +my $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph +$人++; # a child is born +print $人, "\n"; +EXPECT +3 +######## example from Camel 5, ch. 15, pp.406 (with our) +# SKIP: ord "A" == 193 # EBCDIC +use strict; +use utf8; +our $人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph +$人++; # a child is born +print $人, "\n"; +EXPECT +3 +######## example from Camel 5, ch. 15, pp.406 (with package vars) +# SKIP: ord "A" == 193 # EBCDIC +use utf8; +$人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph +$人++; # a child is born +print $人, "\n"; +EXPECT +3 +######## example from Camel 5, ch. 15, pp.406 (with use vars) +# SKIP: ord "A" == 193 # EBCDIC +use strict; +use utf8; +use vars qw($人); +$人 = 2; # 0xe4 0xba 0xba: U+4eba, "human" in CJK ideograph +$人++; # a child is born +print $人, "\n"; +EXPECT +3 +######## +# test that closures generated by eval"" hold on to the CV of the eval"" +# for their entire lifetime +$code = eval q[ + sub { eval '$x = "ok 1\n"'; } +]; +&{$code}(); +print $x; +EXPECT +ok 1 +######## [ID 20020623.009] nested eval/sub segfaults +$eval = eval 'sub { eval "sub { %S }" }'; +$eval->({}); +######## [perl #17951] Strange UTF error +-W +# From: "John Kodis" +# Newsgroups: comp.lang.perl.moderated +# Subject: Strange UTF error +# Date: Fri, 11 Oct 2002 16:19:58 -0400 +# Message-ID: +$_ = "foobar\n"; +utf8::upgrade($_); # the original code used a UTF-8 locale (affects STDIN) +# matching is actually irrelevant: avoiding several dozen of these +# Illegal hexadecimal digit ' ' ignored at /usr/lib/perl5/5.8.0/utf8_heavy.pl line 152 +# is what matters. +/^([[:digit:]]+)/; +EXPECT +######## [perl #20667] unicode regex vs non-unicode regex +$toto = 'Hello'; +$toto =~ /\w/; # this line provokes the problem! +$name = 'A B'; +# utf8::upgrade($name) if @ARGV; +if ($name =~ /(\p{IsUpper}) (\p{IsUpper})/){ + print "It's good! >$1< >$2<\n"; +} else { + print "It's not good...\n"; +} +EXPECT +It's good! >A< >B< +######## [perl #8760] strangness with utf8 and warn +$_="foo";utf8::upgrade($_);/bar/i,warn$_; +EXPECT +foo at - line 1. +######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> +-lw +BEGIN { + eval 'require Fcntl'; + if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest? +} +if ($^O eq 'VMS') { # VMS is not *that* kind of a glob. +print qq[./"TEST"\n./"TEST"\n]; +} else { +print glob(q(./"TEST")); +use File::Glob; +print glob(q(./"TEST")); +} +EXPECT +./"TEST" +./"TEST" +######## glob() bug Mon, 01 Sep 2003 02:25:41 -0700 <200309010925.h819Pf0X011457@smtp3.ActiveState.com> +-lw +BEGIN { + eval 'require Fcntl'; + if ($@) { print qq[./"TEST"\n./"TEST"\n]; exit 0 } # running minitest? +} +if ($^O eq 'VMS') { # VMS is not *that* kind of a glob. +print qq[./"TEST"\n./"TEST"\n]; +} else { +use File::Glob; +print glob(q(./"TEST")); +use File::Glob; +print glob(q(./"TEST")); +} +EXPECT +./"TEST" +./"TEST" +######## "Segfault using HTML::Entities", Richard Jolly , in perl-unicode@perl.org +-lw +# SKIP: use Config; $ENV{PERL_CORE_MINITEST} or " $Config::Config{'extensions'} " !~ m[ Encode ] # Perl configured without Encode module +BEGIN { + eval 'require Encode'; + if ($@) { exit 0 } # running minitest? +} +# Test case cut down by jhi +$SIG{__WARN__} = sub { $@ = shift }; +use Encode; +my $t = "\xE9"; +Encode::_utf8_on($t); +$t =~ s/([^a])//ge; +$@ =~ s/ at .*/ at/; +print $@ +EXPECT +Malformed UTF-8 character (unexpected end of string) in substitution (s///) at