From c517dc2b8939cf1b60644570194e6918e1629206 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 9 Mar 2003 10:46:23 +0000 Subject: From Inaba Hiroto: the UTF-8 length cache wasn't updated when fbm_compile() appended a "\n". p4raw-id: //depot/perl@18857 --- t/op/pat.t | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 't') diff --git a/t/op/pat.t b/t/op/pat.t index fdc4f9b2a1..54f7d144d7 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..994\n"; +print "1..995\n"; BEGIN { chdir 't' if -d 't'; @@ -3145,5 +3145,8 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]"); "[perl #21411] (??{ .. }) corrupts split's stack") } -# last test 994 +{ + ok("\x{100}\n" =~ /\x{100}\n$/, "UTF8 length cache and fbm_compile"); +} +# last test 995 -- cgit v1.2.1 From 16e1b94401335fe86d42338fc14a6680fc469ab0 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 9 Mar 2003 10:54:10 +0000 Subject: From Inaba Hiroto: re_intuit_start set a value to PL_bostr before calling find_byclass when regexp has ROPT_UTF8 flag on. But right value for PL_bostr is set before re_intuit_start is called. PL_regdata is always assigned by cache_re(), so the whole if(prog->reganch & ROPT_UTF8){} can be deleted. p4raw-id: //depot/perl@18858 --- t/op/pat.t | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/pat.t b/t/op/pat.t index 54f7d144d7..85ec2c230a 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -3149,4 +3149,14 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]"); ok("\x{100}\n" =~ /\x{100}\n$/, "UTF8 length cache and fbm_compile"); } -# last test 995 +{ + package Str; + use overload q/""/ => sub { ${$_[0]}; }; + sub new { my ($c, $v) = @_; bless \$v, $c; } + + package main; + $_ = Str->new("a\x{100}/\x{100}b"); + ok(join(":", /\b(.)\x{100}/g) eq "a:/", "re_intuit_start and PL_bostr"); +} + +# last test 996 -- cgit v1.2.1 From 7f07ce5f9bb16b56363fc850014c022807c64864 Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Sun, 9 Mar 2003 11:30:22 +0000 Subject: Adjust test count. p4raw-id: //depot/perl@18859 --- t/op/pat.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 't') diff --git a/t/op/pat.t b/t/op/pat.t index 85ec2c230a..16a38202dd 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..995\n"; +print "1..996\n"; BEGIN { chdir 't' if -d 't'; -- cgit v1.2.1 From 58e33a9028ebaa2c94f6b7cf202a415b19dab366 Mon Sep 17 00:00:00 2001 From: "Adrian M. Enache" Date: Sat, 8 Mar 2003 01:28:37 +0200 Subject: Re: [perl #21498] printf behaviour changes 5.6.1(and earlier) -> 5.8 Message-ID: <20030307212837.GB765@ratsnest.hole> (and few more test cases from the thread) p4raw-id: //depot/perl@18861 --- t/op/sprintf.t | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 't') diff --git a/t/op/sprintf.t b/t/op/sprintf.t index e498c65b35..5a046eccac 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -359,7 +359,7 @@ __END__ >%2$d %d %d< >[12, 34]< >34 12 34< >%3$d %d %d< >[12, 34, 56]< >56 12 34< >%2$*3$d %d< >[12, 34, 3]< > 34 12< ->%*3$2$d %d< >[12, 34, 3]< >%*3$2$d 34 INVALID< +>%*3$2$d %d< >[12, 34, 3]< >%*3$2$d 12 INVALID< >%2$d< >12< >0 UNINIT< >%0$d< >12< >%0$d INVALID< >%1$$d< >12< >%1$$d INVALID< @@ -374,4 +374,9 @@ __END__ >%vs,%d< >[1, 2, 3]< >1,2< >%v_< >''< >%v_ INVALID< >%v#x< >''< >%v#x INVALID< ->%v02x< >"foo\n"< >66.6f.6f.0a< +>%v02x< >"foo\n"< >66.6f.6f.0a< +>%V-%s< >["Hello"]< >%V-Hello INVALID< +>%K %d %d< >[13, 29]< >%K 13 29 INVALID< +>%*.*K %d< >[13, 29, 76]< >%*.*K 13 INVALID< +>%4$K %d< >[45, 67]< >%4$K 45 INVALID< +>%d %K %d< >[23, 45]< >23 %K 45 INVALID< -- cgit v1.2.1 From 77d32bb7b5e051854298049d5aa8bdccf2df099a Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Sun, 9 Mar 2003 11:48:37 +0000 Subject: ... and add a test case for bug #20798 p4raw-id: //depot/perl@18862 --- t/op/eval.t | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/eval.t b/t/op/eval.t index 8e8f69c0b8..a6d78c4dbd 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; } -print "1..87\n"; +print "1..88\n"; eval 'print "ok 1\n";'; @@ -419,3 +419,6 @@ $test++; $test++; } } + +sub Foo {} print Foo(eval {}); +print "ok ",$test++," - #20798 (used to dump core)\n"; -- cgit v1.2.1 From 11c2f0cfb6e853c95c93eb8b1c17c45bc95a9f84 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Mon, 10 Mar 2003 06:35:20 +0000 Subject: Comment fix. p4raw-id: //depot/perl@18876 --- t/io/utf8.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 't') diff --git a/t/io/utf8.t b/t/io/utf8.t index edf5fddb74..28090112fc 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -322,7 +322,7 @@ print "ok 26\n"; $t++; } } - # last test here 47 + # last test here 49 } # sysread() and syswrite() tested in lib/open.t since Fnctl is used -- cgit v1.2.1 From b77f7d40943072c6b8a82e9e0fbdcc2d346120ee Mon Sep 17 00:00:00 2001 From: Yitzchak Scott-Thoennes Date: Fri, 7 Mar 2003 05:12:49 -0800 Subject: Re: odd (or not so odd?) segmentation fault in 5.8.0 Message-ID: p4raw-id: //depot/perl@18889 --- t/op/tie.t | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 't') diff --git a/t/op/tie.t b/t/op/tie.t index 6e73ceec85..49c189e66f 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -286,3 +286,12 @@ EXPECT 7 8 0 +######## +# +# FETCH freeing tie'd SV +sub TIESCALAR { bless [] } +sub FETCH { *a = \1; 1 } +tie $a, 'main'; +print $a; +EXPECT +Tied variable freed while still in use at - line 6. -- cgit v1.2.1 From a4c0dc87024a3e2a076df79e21b4fe3438f88e49 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Mon, 10 Mar 2003 21:44:12 +0000 Subject: VMS has an extra \n at the end, and I assume Windows has \r\n. p4raw-id: //depot/perl@18899 --- t/run/switchC.t | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 't') diff --git a/t/run/switchC.t b/t/run/switchC.t index c3cc4033a7..0f8f16a6ce 100644 --- a/t/run/switchC.t +++ b/t/run/switchC.t @@ -23,7 +23,7 @@ END { unlink @tmpfiles } $r = runperl( switches => [ '-CO', '-w' ], prog => 'print chr(256)', stderr => 1 ); -is( $r, "\xC4\x80", '-CO: no warning on UTF-8 output' ); +like( $r, qr/^\xC4\x80(?:\r?\n)?$/s, '-CO: no warning on UTF-8 output' ); SKIP: { if (exists $ENV{PERL_UNICODE} && @@ -34,30 +34,29 @@ SKIP: { prog => 'print ord()', stderr => 1, stdin => "\xC4\x80" ); - is( $r, 256, '-CI: read in UTF-8 input' ); + like( $r, qr/^256(?:\r?\n)?$/s, '-CI: read in UTF-8 input' ); } $r = runperl( switches => [ '-CE', '-w' ], prog => 'warn chr(256), qq(\n)', stderr => 1 ); -chomp $r; -is( $r, "\xC4\x80", '-CE: UTF-8 stderr' ); +like( $r, qr/^\xC4\x80(?:\r?\n)?$/s, '-CE: UTF-8 stderr' ); $r = runperl( switches => [ '-Co', '-w' ], prog => 'open(F, q(>out)); print F chr(256); close F', stderr => 1 ); -is( $r, '', '-Co: auto-UTF-8 open for output' ); +like( $r, qr/^$/s, '-Co: auto-UTF-8 open for output' ); push @tmpfiles, "out"; $r = runperl( switches => [ '-Ci', '-w' ], prog => 'open(F, q(); close F', stderr => 1 ); -is( $r, 256, '-Ci: auto-UTF-8 open for input' ); +like( $r, qr/^256(?:\r?\n)?$/s, '-Ci: auto-UTF-8 open for input' ); $r = runperl( switches => [ '-CA', '-w' ], prog => 'print ord shift', stderr => 1, args => [ chr(256) ] ); -is( $r, 256, '-CA: @ARGV' ); +like( $r, qr/^256(?:\r?\n)?$/s, '-CA: @ARGV' ); -- cgit v1.2.1 From e1c3fb40dd782fd9b634587360c23d899b86794d Mon Sep 17 00:00:00 2001 From: Rafael Garcia-Suarez Date: Mon, 10 Mar 2003 22:12:37 +0000 Subject: Integrate (by hand) change #18386 from maint-5.8 p4raw-link: @18386 on //depot/maint-5.8/perl: ae482bddc28bdefe6941bbd8dd2654bdbf1d93be p4raw-id: //depot/perl@18900 --- t/op/split.t | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) (limited to 't') diff --git a/t/op/split.t b/t/op/split.t index 3d7e89880b..55b2839b0c 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 50; +plan tests => 52; $FS = ':'; @@ -265,15 +265,14 @@ ok(@ary == 3 && { # [perl #18195] - for my $a (0,1) { - $_ = 'readin,database,readout'; - if ($ARGV[0]) { - $_ .= chr 256; - chop; + for my $u (0, 1) { + for my $a (0, 1) { + $_ = 'readin,database,readout'; + utf8::upgrade $_ if $u; + /(.+)/; + my @d = split /[,]/,$1; + is(join (':',@d), 'readin:database:readout', "[perl #18195]"); } - /(.+)/; - my @d = split /[,]/,$1; - is(join (':',@d), 'readin:database:readout', "[perl #18195]") } } -- cgit v1.2.1 From bb4e15c885adf67b857fe3eac0488b3b9685b93d Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 11 Mar 2003 05:19:15 +0000 Subject: Patch from Craig Berry to resolve test failures in VMS. Will poke the Net::Ping author. p4raw-id: //depot/perl@18902 --- t/io/utf8.t | 101 ++++++++++++++++++++++------------------------------------- t/op/magic.t | 1 + 2 files changed, 39 insertions(+), 63 deletions(-) (limited to 't') diff --git a/t/io/utf8.t b/t/io/utf8.t index 28090112fc..e5005e5d64 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -11,56 +11,44 @@ BEGIN { no utf8; # needed for use utf8 not griping about the raw octets +require "./test.pl"; + +plan(tests => 49); + $| = 1; -print "1..49\n"; open(F,"+>:utf8",'a'); print F chr(0x100).'£'; -print '#'.tell(F)."\n"; -print "not " unless tell(F) == 4; -print "ok 1\n"; +ok( tell(F) == 4, tell(F) ); print F "\n"; -print '#'.tell(F)."\n"; -print "not " unless tell(F) >= 5; -print "ok 2\n"; +ok( tell(F) >= 5, tell(F) ); seek(F,0,0); -print "not " unless getc(F) eq chr(0x100); -print "ok 3\n"; -print "not " unless getc(F) eq "£"; -print "ok 4\n"; -print "not " unless getc(F) eq "\n"; -print "ok 5\n"; +ok( getc(F) eq chr(0x100) ); +ok( getc(F) eq "£" ); +ok( getc(F) eq "\n" ); seek(F,0,0); binmode(F,":bytes"); my $chr = chr(0xc4); if (ord('A') == 193) { $chr = chr(0x8c); } # EBCDIC -print "not " unless getc(F) eq $chr; -print "ok 6\n"; +ok( getc(F) eq $chr ); $chr = chr(0x80); if (ord('A') == 193) { $chr = chr(0x41); } # EBCDIC -print "not " unless getc(F) eq $chr; -print "ok 7\n"; +ok( getc(F) eq $chr ); $chr = chr(0xc2); if (ord('A') == 193) { $chr = chr(0x80); } # EBCDIC -print "not " unless getc(F) eq $chr; -print "ok 8\n"; +ok( getc(F) eq $chr ); $chr = chr(0xa3); if (ord('A') == 193) { $chr = chr(0x44); } # EBCDIC -print "not " unless getc(F) eq $chr; -print "ok 9\n"; -print "not " unless getc(F) eq "\n"; -print "ok 10\n"; +ok( getc(F) eq $chr ); +ok( getc(F) eq "\n" ); seek(F,0,0); binmode(F,":utf8"); -print "not " unless scalar() eq "\x{100}£\n"; -print "ok 11\n"; +ok( scalar() eq "\x{100}£\n" ); seek(F,0,0); $buf = chr(0x200); $count = read(F,$buf,2,1); -print "not " unless $count == 2; -print "ok 12\n"; -print "not " unless $buf eq "\x{200}\x{100}£"; -print "ok 13\n"; +ok( $count == 2 ); +ok( $buf eq "\x{200}\x{100}£" ); close(F); { @@ -74,8 +62,7 @@ close(F); open F, "<:utf8", 'a' or die $!; $x = ; chomp($x); - print "not " unless $x eq chr(300); - print "ok 14\n"; + ok( $x eq chr(300) ); open F, "a" or die $!; # Not UTF binmode(F, ":bytes"); @@ -83,8 +70,7 @@ close(F); chomp($x); $chr = chr(196).chr(172); if (ord('A') == 193) { $chr = chr(141).chr(83); } # EBCDIC - print "not " unless $x eq $chr; - print "ok 15\n"; + ok( $x eq $chr ); close F; open F, ">:utf8", 'a' or die $!; @@ -94,29 +80,25 @@ close(F); my $y; { my $x = tell(F); { use bytes; $y = length($a);} - print "not " unless $x == $y; - print "ok 16\n"; + ok( $x == $y ); } { # Check byte length of $b use bytes; my $y = length($b); - print "not " unless $y == 1; - print "ok 17\n"; + ok( $y == 1 ); } print F $b,"\n"; # Don't upgrades $b { # Check byte length of $b use bytes; my $y = length($b); - print "not ($y) " unless $y == 1; - print "ok 18\n"; + ok( $y == 1 ); } { my $x = tell(F); { use bytes; if (ord('A')==193){$y += 2;}else{$y += 3;}} # EBCDIC ASCII - print "not ($x,$y) " unless $x == $y; - print "ok 19\n"; + ok( $x == $y ); } close F; @@ -127,15 +109,13 @@ close(F); chomp($x); $chr = v196.172.194.130; if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC - printf "not (%vd) ", $x unless $x eq $chr; - print "ok 20\n"; + ok( $x eq $chr, sprintf('(%vd)', $x) ); open F, "<:utf8", "a" or die $!; $x = ; chomp($x); close F; - printf "not (%vd) ", $x unless $x eq chr(300).chr(130); - print "ok 21\n"; + ok( $x eq chr(300).chr(130), sprintf('(%vd)', $x) ); open F, ">", "a" or die $!; if (${^OPEN} =~ /:utf8/) { @@ -148,9 +128,8 @@ close(F); use warnings 'utf8'; local $SIG{__WARN__} = sub { $w = $_[0] }; print F $a; - print "not " if ($@ || $w !~ /Wide character in print/i); + ok( !($@ || $w !~ /Wide character in print/i) ); } - print "ok 22\n"; } # Hm. Time to get more evil. @@ -165,8 +144,7 @@ binmode(F, ":bytes"); $x = ; chomp $x; $chr = v196.172.130; if (ord('A') == 193) { $chr = v141.83.130; } # EBCDIC -print "not " unless $x eq $chr; -print "ok 23\n"; +ok( $x eq $chr ); # Right. open F, ">:utf8", "a" or die $!; @@ -178,17 +156,16 @@ close F; open F, "<", "a" or die $!; $x = ; chomp $x; -print "not " unless $x eq $chr; -print "ok 24\n"; +ok( $x eq $chr ); # Now we have a deformed file. if (ord('A') == 193) { - print "ok 25 # Skip: EBCDIC\n"; # EBCDIC doesn't complain + skip( "EBCDIC doesn't complain" ); } else { open F, "<:utf8", "a" or die $!; $x = ; chomp $x; - local $SIG{__WARN__} = sub { print "ok 25\n" }; + local $SIG{__WARN__} = sub { ok( 1 ) }; eval { sprintf "%vd\n", $x }; } @@ -223,7 +200,7 @@ for (@a) { } } close F; -print "ok 26\n"; +ok( 1 ); { # Check that warnings are on on I/O, and that they can be muffled. @@ -236,14 +213,14 @@ print "ok 26\n"; print F chr(0x100); close(F); - print $@ =~ /Wide character in print/ ? "ok 27\n" : "not ok 27\n"; + like( $@, 'Wide character in print' ); undef $@; open F, ">:utf8", "a"; print F chr(0x100); close(F); - print defined $@ ? "not ok 28\n" : "ok 28\n"; + isnt( defined $@ ); undef $@; open F, ">a"; @@ -251,7 +228,7 @@ print "ok 26\n"; print F chr(0x100); close(F); - print defined $@ ? "not ok 29\n" : "ok 29\n"; + isnt( defined $@ ); no warnings 'utf8'; @@ -260,7 +237,7 @@ print "ok 26\n"; print F chr(0x100); close(F); - print defined $@ ? "not ok 30\n" : "ok 30\n"; + isnt( defined $@ ); use warnings 'utf8'; @@ -270,7 +247,7 @@ print "ok 26\n"; print F chr(0x100); close(F); - print $@ =~ /Wide character in print/ ? "ok 31\n" : "not ok 31\n"; + like( $@, 'Wide character in print' ); } { @@ -279,8 +256,7 @@ print "ok 26\n"; open F, "<:bytes", "a"; my $b = chr 0x100; $b .= ; - print $b eq chr(0x100).chr(0xde) ? "ok 32" : "not ok 32"; - print " \#21395 '.= <>' utf8 vs. bytes\n"; + ok( $b eq chr(0x100).chr(0xde), "21395 '.= <>' utf8 vs. bytes" ); close F; } @@ -290,8 +266,7 @@ print "ok 26\n"; open F, "<:utf8", "a"; my $b = "\xde"; $b .= ; - print $b eq chr(0xde).chr(0x100) ? "ok 33" : "not ok 33"; - print " \#21395 '.= <>' bytes vs. utf8\n"; + ok( $b eq chr(0xde).chr(0x100), "21395 '.= <>' bytes vs. utf8" ); close F; } diff --git a/t/op/magic.t b/t/op/magic.t index 8f598a1049..3279e1e4ea 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -124,6 +124,7 @@ END } END close CMDPIPE; + $? >>= 8 if $^O eq 'VMS'; # POSIX status hiding in 2nd byte print $? & 0xFF ? "ok 6\n" : "not ok 6\n"; $test += 4; -- cgit v1.2.1 From 38295cca2bcea18247fdba079ba504a69c9fda94 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 11 Mar 2003 05:29:12 +0000 Subject: A rejected hunk of #18902 reapplied. p4raw-id: //depot/perl@18903 --- t/io/utf8.t | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 't') diff --git a/t/io/utf8.t b/t/io/utf8.t index e5005e5d64..c7ad296d8d 100755 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -291,8 +291,7 @@ ok( 1 ); utf8::upgrade($s) if $v->[1] eq "utf8"; $s .= ; - print $s eq chr($v->[0]) . chr($u->[0]) ? - "ok $t # rcatline utf8\n" : "not ok $t # rcatline utf8\n"; + ok( $s eq chr($v->[0]) . chr($u->[0]), 'rcatline utf8' ); close F; $t++; } -- cgit v1.2.1 From a6d0563455796929d2aae5a18fb57e80a20f87bd Mon Sep 17 00:00:00 2001 From: "Todd C. Miller" Date: Mon, 10 Mar 2003 14:00:55 -0700 Subject: typos and other minor things From: "Todd C. Miller" Message-Id: <200303110400.h2B40tEQ018838@xerxes.courtesan.com> p4raw-id: //depot/perl@18904 --- t/op/sprintf.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 't') diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 5a046eccac..f48b6d3712 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -104,7 +104,7 @@ for ($i = 1; @tests; $i++) { } } -# In each of the the following lines, there are three required fields: +# In each of the following lines, there are three required fields: # printf template, data to be formatted (as a Perl expression), and # expected result of formatting. An optional fourth field can contain # a comment. Each field is delimited by a starting '>' and a -- cgit v1.2.1 From 87569c6da19c98dc8db22ce673f8dbad79d7e442 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 11 Mar 2003 09:18:25 +0000 Subject: Try to handle hitting the heap/data limit in small systems. (One can simulate this with e.g. 32MB or 64MB datasize, use your shell's ulimit/limit/limits command.) p4raw-id: //depot/perl@18914 --- t/op/recurse.t | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 't') diff --git a/t/op/recurse.t b/t/op/recurse.t index 9d0064068b..af875127cb 100755 --- a/t/op/recurse.t +++ b/t/op/recurse.t @@ -113,8 +113,19 @@ is(takeuchi($x, $y, $z), $z + 1, "takeuchi($x, $y, $z) == $z + 1"); } # check ok for recursion depth > 65536 -is(runperl( - nolib => 1, - prog => q{$d=0; $e=1; sub c { ++$d; if ($d > 66000) { $e=0 } else { c(); c() unless $d % 32768 } --$d } c(); exit $e}, -), '', "64K deep recursion - no output expected"); -is($?, 0, "64K deep recursion - no coredump expected"); +{ + my $r; + eval { + $r = runperl( + nolib => 1, + stderr => 1, + prog => q{$d=0; $e=1; sub c { ++$d; if ($d > 66000) { $e=0 } else { c(); c() unless $d % 32768 } --$d } c(); exit $e}); + }; + SKIP: { + skip("Out of memory -- increase your data/heap?", 2) + if $r =~ /Out of memory!/; + is($r, '', "64K deep recursion - no output expected"); + is($?, 0, "64K deep recursion - no coredump expected"); + } +} + -- cgit v1.2.1 From d39768499da99326f8ba53c159f9e35346473a2d Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Tue, 11 Mar 2003 09:19:54 +0000 Subject: Be more lax about the out of memory error message. p4raw-id: //depot/perl@18915 --- t/op/recurse.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 't') diff --git a/t/op/recurse.t b/t/op/recurse.t index af875127cb..66c33ef3b2 100755 --- a/t/op/recurse.t +++ b/t/op/recurse.t @@ -123,7 +123,7 @@ is(takeuchi($x, $y, $z), $z + 1, "takeuchi($x, $y, $z) == $z + 1"); }; SKIP: { skip("Out of memory -- increase your data/heap?", 2) - if $r =~ /Out of memory!/; + if $r =~ /Out of memory/i; is($r, '', "64K deep recursion - no output expected"); is($?, 0, "64K deep recursion - no coredump expected"); } -- cgit v1.2.1 From 63c6dcc1775b960c3418c4c23568c59231321ed1 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Wed, 12 Mar 2003 10:52:17 +0000 Subject: Integrate: [ 18946] Integrate from maint-5.8/macperl: [ 18937] Various MacOS portability fixes for tests [ 18938] File::Spec::Unix method should be called on $self [ 18939] lib.pm:_get_dirs() should use $_[0], not $_ [ 18940] Update MacOS for new configpm [ 18941] Update MacOS build Update Makefile for new source files, update test script, add additional symbol for APItest p4raw-link: @18946 on //depot/maint-5.8/perl: 494df11159c23652339c95affadb99da70ef89e6 p4raw-link: @18941 on //depot/maint-5.8/macperl: 9b3df31c299856a4cb17c1b4a9c403df0a69ec28 p4raw-link: @18940 on //depot/maint-5.8/macperl: 5d97ba7550864e5eaacd84839be0d01c212a6d00 p4raw-link: @18939 on //depot/maint-5.8/macperl: be568d45c1392c31a2787cdaf2ab37fb4a91ced1 p4raw-link: @18938 on //depot/maint-5.8/macperl: efc910e725c427d20af16b2fdf1d43228fecfc02 p4raw-link: @18937 on //depot/maint-5.8/macperl: bbcece98349dade0635a793d66ae4e883c9097d6 p4raw-id: //depot/perl@18951 p4raw-integrated: from //depot/maint-5.8/perl@18950 'copy in' ext/POSIX/t/taint.t t/op/stat.t (@17645..) lib/Unicode/Collate/t/index.t lib/Unicode/Collate/t/test.t lib/lib_pm.PL t/op/mkdir.t (@18080..) ext/Filter/t/call.t lib/charnames.t t/op/taint.t t/run/switchI.t (@18458..) lib/File/Spec/Unix.pm (@18466..) t/io/crlf.t (@18638..) ext/Digest/MD5/t/files.t (@18743..) t/op/method.t (@18850..) t/pod/testp2pt.pl (@18890..) t/op/sprintf.t (@18911..) t/op/recurse.t (@18922..) p4raw-branched: from //depot/maint-5.8/perl@18946 'branch in' macos/MacPerlTests.cmd macos/Makefile.mk macos/configpm macos/macperl.sym --- t/io/crlf.t | 2 +- t/op/method.t | 1 + t/op/mkdir.t | 13 +++++++++---- t/op/recurse.t | 8 +++++++- t/op/sprintf.t | 2 +- t/op/stat.t | 2 +- t/op/taint.t | 8 ++++++-- t/pod/testp2pt.pl | 2 ++ t/run/switchI.t | 20 ++++++++++++++------ 9 files changed, 42 insertions(+), 16 deletions(-) (limited to 't') diff --git a/t/io/crlf.t b/t/io/crlf.t index 5f879f2681..084be211fd 100644 --- a/t/io/crlf.t +++ b/t/io/crlf.t @@ -35,7 +35,7 @@ if (find PerlIO::Layer 'perlio') { eval 'use PerlIO::scalar'; skip(q/miniperl cannnot load PerlIO::scalar/) if $@ =~ /dynamic loading not available/; - my $fcontents = join "", map {"$_\r\n"} "a".."zzz"; + my $fcontents = join "", map {"$_\015\012"} "a".."zzz"; open my $fh, "<:crlf", \$fcontents; local $/ = "xxx"; local $_ = <$fh>; diff --git a/t/op/method.t b/t/op/method.t index ae8031a9f6..aaf29be8df 100755 --- a/t/op/method.t +++ b/t/op/method.t @@ -284,6 +284,7 @@ for my $meth (['Bar', 'Foo::Bar'], { fresh_perl_is(<$meth->[0](); EOT diff --git a/t/op/mkdir.t b/t/op/mkdir.t index b9c4df785a..226089b0c8 100755 --- a/t/op/mkdir.t +++ b/t/op/mkdir.t @@ -24,7 +24,12 @@ print ($! =~ /cannot find|such|exist|not found|not a directory/i ? "ok 7\n" : "# print (mkdir('blurfl') ? "ok 8\n" : "not ok 8\n"); print (rmdir('blurfl') ? "ok 9\n" : "not ok 9\n"); # trailing slashes will be removed before the system call to mkdir -print (mkdir('blurfl///') ? "ok 10\n" : "not ok 10\n"); -print (-d 'blurfl' ? "ok 11\n" : "not ok 11\n"); -print (rmdir('blurfl///') ? "ok 12\n" : "not ok 12\n"); -print (!-d 'blurfl' ? "ok 13\n" : "not ok 13\n"); +# but we don't care for MacOS ... +if ($^O eq 'MacOS') { + print "ok $_\n" for 10..13; +} else { + print (mkdir('blurfl///') ? "ok 10\n" : "not ok 10\n"); + print (-d 'blurfl' ? "ok 11\n" : "not ok 11\n"); + print (rmdir('blurfl///') ? "ok 12\n" : "not ok 12\n"); + print (!-d 'blurfl' ? "ok 13\n" : "not ok 13\n"); +} diff --git a/t/op/recurse.t b/t/op/recurse.t index 66c33ef3b2..10830e6221 100755 --- a/t/op/recurse.t +++ b/t/op/recurse.t @@ -125,7 +125,13 @@ is(takeuchi($x, $y, $z), $z + 1, "takeuchi($x, $y, $z) == $z + 1"); skip("Out of memory -- increase your data/heap?", 2) if $r =~ /Out of memory/i; is($r, '', "64K deep recursion - no output expected"); - is($?, 0, "64K deep recursion - no coredump expected"); + + if ($^O eq 'MacOS') { + ok(1, "$^O: \$? is unreliable"); + } else { + is($?, 0, "64K deep recursion - no coredump expected"); + } + } } diff --git a/t/op/sprintf.t b/t/op/sprintf.t index f48b6d3712..e767a7885c 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -374,7 +374,7 @@ __END__ >%vs,%d< >[1, 2, 3]< >1,2< >%v_< >''< >%v_ INVALID< >%v#x< >''< >%v#x INVALID< ->%v02x< >"foo\n"< >66.6f.6f.0a< +>%v02x< >"foo\012"< >66.6f.6f.0a< >%V-%s< >["Hello"]< >%V-Hello INVALID< >%K %d %d< >[13, 29]< >%K 13 29 INVALID< >%*.*K %d< >[13, 29, 76]< >%*.*K 13 INVALID< diff --git a/t/op/stat.t b/t/op/stat.t index 3cdfc233c9..df478b09de 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -55,7 +55,7 @@ SKIP: { SKIP: { skip "mtime and ctime not reliable", 2 - if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos; + if $Is_MSWin32 or $Is_NetWare or $Is_Cygwin or $Is_Dos or $Is_MacOS; ok( $mtime, 'mtime' ); is( $mtime, $ctime, 'mtime == ctime' ); diff --git a/t/op/taint.t b/t/op/taint.t index 686354ed2f..846e1fd8fd 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -966,8 +966,12 @@ else eval { system("lskdfj does not exist","with","args"); }; test 204, $@ eq ''; - eval { exec("lskdfj does not exist","with","args"); }; - test 205, $@ eq ''; + if ($Is_MacOS) { + print "ok 205 # no exec()\n"; + } else { + eval { exec("lskdfj does not exist","with","args"); }; + test 205, $@ eq ''; + } # If you add tests here update also the above skip block for VMS. } diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl index bec55e45b4..a828e85113 100644 --- a/t/pod/testp2pt.pl +++ b/t/pod/testp2pt.pl @@ -38,7 +38,9 @@ sub catfile(@) { File::Spec->catfile(@_); } my $INSTDIR = abs_path(dirname $0); $INSTDIR = VMS::Filespec::unixpath($INSTDIR) if $^O eq 'VMS'; $INSTDIR =~ s#/$## if $^O eq 'VMS'; +$INSTDIR =~ s#:$## if $^O eq 'MacOS'; $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod'); +$INSTDIR =~ s#:$## if $^O eq 'MacOS'; $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't'); my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'), catfile($INSTDIR, 'scripts'), diff --git a/t/run/switchI.t b/t/run/switchI.t index fcd2dc00f2..41192cd765 100644 --- a/t/run/switchI.t +++ b/t/run/switchI.t @@ -10,16 +10,24 @@ BEGIN { plan(4); } -ok(grep { $_ eq 'Bla' } @INC); +my $Is_MacOS = $^O eq 'MacOS'; +my $Is_VMS = $^O eq 'VMS'; +my $lib; + +$lib = $Is_MacOS ? ':Bla:' : 'Bla'; +ok(grep { $_ eq $lib } @INC); SKIP: { - skip 'Double colons not allowed in dir spec', 1 if $^O eq 'VMS'; - ok(grep { $_ eq 'Foo::Bar' } @INC); + skip 'Double colons not allowed in dir spec', 1 if $Is_VMS; + $lib = $Is_MacOS ? 'Foo::Bar:' : 'Foo::Bar'; + ok(grep { $_ eq $lib } @INC); } -fresh_perl_is('print grep { $_ eq "Bla2" } @INC', 'Bla2', +$lib = $Is_MacOS ? ':Bla2:' : 'Bla2'; +fresh_perl_is("print grep { \$_ eq '$lib' } \@INC", $lib, { switches => ['-IBla2'] }, '-I'); SKIP: { - skip 'Double colons not allowed in dir spec', 1 if $^O eq 'VMS'; - fresh_perl_is('print grep { $_ eq "Foo::Bar2" } @INC', 'Foo::Bar2', + skip 'Double colons not allowed in dir spec', 1 if $Is_VMS; + $lib = $Is_MacOS ? 'Foo::Bar2:' : 'Foo::Bar2'; + fresh_perl_is("print grep { \$_ eq '$lib' } \@INC", $lib, { switches => ['-IFoo::Bar2'] }, '-I with colons'); } -- cgit v1.2.1 From ab5fe4d6aaf45c57b7af4b994a730291eee17efa Mon Sep 17 00:00:00 2001 From: Kurt Starsinic Date: Sun, 9 Mar 2003 19:54:49 -0500 Subject: [perl #20755] [PATCH] 5.8.0 h2ph barfs on checksum.h on RH6.2/7.2 Message-ID: p4raw-id: //depot/perl@18963 --- t/lib/h2ph.h | 11 +++++++++++ t/lib/h2ph.pht | 1 + 2 files changed, 12 insertions(+) (limited to 't') diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h index c60e8f008d..f13b69c6d6 100644 --- a/t/lib/h2ph.h +++ b/t/lib/h2ph.h @@ -121,4 +121,15 @@ enum flimflam { flam } flamflim; +/* Handle multi-line quoted strings: */ +__asm__ __volatile__(" + this + produces + no + output +"); + +#define multiline "multiline +string" + #endif /* _H2PH_H_ */ diff --git a/t/lib/h2ph.pht b/t/lib/h2ph.pht index 796d6a8e0b..8bc16369a9 100644 --- a/t/lib/h2ph.pht +++ b/t/lib/h2ph.pht @@ -84,5 +84,6 @@ unless(defined(&_H2PH_H_)) { } eval("sub flim () { 0; }") unless defined(&flim); eval("sub flam () { 1; }") unless defined(&flam); + eval 'sub multiline () {"multilinestring";}' unless defined(&multiline); } 1; -- cgit v1.2.1 From 4a202259b5c58b8852cda4ec492b88e9baff32c6 Mon Sep 17 00:00:00 2001 From: "Adrian M. Enache" Date: Sat, 15 Mar 2003 01:02:42 +0200 Subject: Re: [fix] [perl #21575] Bug with print( followed by a newline Message-ID: <20030314210242.GA1159@ratsnest.hole> (with an added test) p4raw-id: //depot/perl@18986 --- t/comp/parser.t | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/comp/parser.t b/t/comp/parser.t index ad1c5b80bd..54ad351eb1 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -9,7 +9,7 @@ BEGIN { } require "./test.pl"; -plan( tests => 20 ); +plan( tests => 21 ); eval '%@x=0;'; like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' ); @@ -88,3 +88,12 @@ is( $@, '', 'PL_lex_brackstack' ); ${a}{ ${a}[ @{b}{ ${a}{ } + +# Bug #21575 +# ensure that the second print statement works, by playing a bit +# with the test output. +my %data = ( foo => "\n" ); +print "#"; +print( +$data{foo}); +pass(); -- cgit v1.2.1 From 085a16fc645d01e9c317a227fb12575af270d8fb Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 16 Mar 2003 18:07:30 +0000 Subject: IRIX ls -l marks sockets with 'S'. p4raw-id: //depot/perl@18997 --- t/op/stat.t | 5 +++++ 1 file changed, 5 insertions(+) (limited to 't') diff --git a/t/op/stat.t b/t/op/stat.t index df478b09de..89046c364b 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -242,6 +242,11 @@ SKIP: { $DEV =~ s{^.+?\s\..+?$}{}m; @DEV = grep { ! m{^\..+$} } @DEV; + # Irix ls -l marks sockets with 'S' while 's' is a 'XENIX semaphore'. + if ($^O eq 'irix') { + $DEV =~ s{^S(.+?)}{s$1}mg; + } + my $try = sub { my @c1 = eval qq[\$DEV =~ /^$_[0].*/mg]; my @c2 = eval qq[grep { $_[1] "/dev/\$_" } \@DEV]; -- cgit v1.2.1 From 497043642ba2050cd87b28b50f6a01a0f50d0e90 Mon Sep 17 00:00:00 2001 From: LAUN Wolfgang Date: Mon, 17 Mar 2003 14:55:37 +0100 Subject: pack changes and related fixes Message-ID: <75A46BF1A9D8D311863A00508B6259A405F17EB8@ATTMSX4> p4raw-id: //depot/perl@19010 --- t/lib/warnings/pp_pack | 12 ++--- t/op/pack.t | 121 ++++++++++++++++++++++++++++++++++++++++++++----- 2 files changed, 116 insertions(+), 17 deletions(-) (limited to 't') diff --git a/t/lib/warnings/pp_pack b/t/lib/warnings/pp_pack index 62fa6ecfc7..0f447c75b6 100644 --- a/t/lib/warnings/pp_pack +++ b/t/lib/warnings/pp_pack @@ -18,8 +18,8 @@ no warnings 'unpack' ; my @b = unpack ("A,A", "22") ; my $b = pack ("A,A", 1,2) ; EXPECT -Invalid type in unpack: ',' at - line 4. -Invalid type in pack: ',' at - line 5. +Invalid type ',' in unpack at - line 4. +Invalid type ',' in pack at - line 5. ######## # pp.c use warnings 'uninitialized' ; @@ -73,10 +73,10 @@ print unpack("c", pack("c", -128)), "\n"; print unpack("c", pack("c", 127)), "\n"; print unpack("c", pack("c", 128)), "\n"; EXPECT -Character in "C" format wrapped at - line 3. -Character in "C" format wrapped at - line 3. -Character in "c" format wrapped at - line 3. -Character in "c" format wrapped at - line 3. +Character in 'C' format wrapped in pack at - line 3. +Character in 'C' format wrapped in pack at - line 3. +Character in 'c' format wrapped in pack at - line 3. +Character in 'c' format wrapped in pack at - line 3. 255 0 255 diff --git a/t/op/pack.t b/t/op/pack.t index 9ac5d38f25..af54fdce79 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 5827; +plan tests => 5849; use strict; use warnings; @@ -263,7 +263,7 @@ foreach my $t (@templates) { my @t = eval { unpack("$t*", pack("$t*", 12, 34)) }; # quads not supported everywhere - skip "Quads not supported", 4 if $@ =~ /Invalid type in pack/; + skip "Quads not supported", 4 if $@ =~ /Invalid type/; is( $@, '' ); is(scalar @t, 2); @@ -378,7 +378,7 @@ sub numbers_with_total { SKIP: { my $out = eval {unpack($format, pack($format, $_))}; skip "cannot pack '$format' on this perl", 2 if - $@ =~ /Invalid type in pack: '$format'/; + $@ =~ /Invalid type '$format'/; is($@, ''); is($out, $_); @@ -398,7 +398,7 @@ sub numbers_with_total { SKIP: { my $sum = eval {unpack "%$_$format*", pack "$format*", @_}; skip "cannot pack '$format' on this perl", 3 - if $@ =~ /Invalid type in pack: '$format'/; + if $@ =~ /Invalid type '$format'/; is($@, ''); ok(defined $sum); @@ -519,10 +519,10 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde"); my ($x, $y, $z); eval { ($x) = unpack '/a*','hello' }; - like($@, qr!/ must follow a numeric type!); + like($@, qr!'/' must follow a numeric type!); undef $x; eval { $x = unpack '/a*','hello' }; - like($@, qr!/ must follow a numeric type!); + like($@, qr!'/' must follow a numeric type!); undef $x; eval { ($z,$x,$y) = unpack 'a3/A C/a* C/Z', "003ok \003yes\004z\000abc" }; @@ -538,10 +538,10 @@ is(pack("V", 0xdeadbeef), "\xef\xbe\xad\xde"); undef $x; eval { ($x) = pack '/a*','hello' }; - like($@, qr!Invalid type in pack: '/'!); + like($@, qr!Invalid type '/'!); undef $x; eval { $x = pack '/a*','hello' }; - like($@, qr!Invalid type in pack: '/'!); + like($@, qr!Invalid type '/'!); $z = pack 'n/a* N/Z* w/A*','string','hi there ','etc'; my $expect = "\000\006string\0\0\0\012hi there \000\003etc"; @@ -781,7 +781,7 @@ foreach ( # from Wolfgang Laun: fix in change #13288 eval { my $t=unpack("P*", "abc") }; - like($@, qr/P must have an explicit size/); + like($@, qr/'P' must have an explicit size/); } { # Grouping constructs @@ -822,6 +822,105 @@ foreach ( is("@a", "@b"); } +{ # more on grouping (W.Laun) + use warnings; + my $warning; + local $SIG{__WARN__} = sub { + $warning = $_[0]; + }; + # @ absolute within ()-group + my $badc = pack( '(a)*', unpack( '(@1a @0a @2)*', 'abcd' ) ); + is( $badc, 'badc' ); + my @b = ( 1, 2, 3 ); + my $buf = pack( '(@1c)((@2C)@3c)', @b ); + is( $buf, "\0\1\0\0\2\3" ); + my @a = unpack( '(@1c)((@2c)@3c)', $buf ); + is( "@a", "@b" ); + + # various unpack count/code scenarios + my @Env = ( a => 'AAA', b => 'BBB' ); + my $env = pack( 'S(S/A*S/A*)*', @Env/2, @Env ); + + # unpack full length - ok + my @pup = unpack( 'S/(S/A* S/A*)', $env ); + is( "@pup", "@Env" ); + + # warn when count/code goes beyond end of string + # \0002 \0001 a \0003 AAA \0001 b \0003 BBB + # 2 4 5 7 10 1213 + eval { @pup = unpack( 'S/(S/A* S/A*)', substr( $env, 0, 13 ) ) }; + like( $@, qr{length/code after end of string} ); + + # postfix repeat count + $env = pack( '(S/A* S/A*)' . @Env/2, @Env ); + + # warn when count/code goes beyond end of string + # \0001 a \0003 AAA \0001 b \0003 BBB + # 2 3c 5 8 10 11 13 16 + eval { @pup = unpack( '(S/A* S/A*)' . @Env/2, substr( $env, 0, 11 ) ) }; + like( $@, qr{length/code after end of string} ); + + # catch stack overflow/segfault + eval { $_ = pack( ('(' x 105) . 'A' . (')' x 105) ); }; + like( $@, qr{Too deeply nested \(\)-groups} ); +} + +{ # syntax checks (W.Laun) + use warnings; + my @warning; + local $SIG{__WARN__} = sub { + push( @warning, $_[0] ); + }; + eval { my $s = pack( 'Ax![4c]A', 1..5 ); }; + like( $@, qr{Malformed integer in \[\]} ); + + eval { my $buf = pack( '(c/*a*)', 'AAA', 'BB' ); }; + like( $@, qr{'/' does not take a repeat count} ); + + eval { my @inf = unpack( 'c/1a', "\x03AAA\x02BB" ); }; + like( $@, qr{'/' does not take a repeat count} ); + + eval { my @inf = unpack( 'c/*a', "\x03AAA\x02BB" ); }; + like( $@, qr{'/' does not take a repeat count} ); + + # white space where possible + my @Env = ( a => 'AAA', b => 'BBB' ); + my $env = pack( ' S ( S / A* S / A* )* ', @Env/2, @Env ); + my @pup = unpack( ' S / ( S / A* S / A* ) ', $env ); + is( "@pup", "@Env" ); + + # white space in 4 wrong places + for my $temp ( 'A ![4]', 'A [4]', 'A *', 'A 4' ){ + eval { my $s = pack( $temp, 'B' ); }; + like( $@, qr{Invalid type } ); + } + + # warning for commas + @warning = (); + my $x = pack( 'I,A', 4, 'X' ); + like( $warning[0], qr{Invalid type ','} ); + + # comma warning only once + @warning = (); + $x = pack( 'C(C,C)C,C', 65..71 ); + like( scalar @warning, 1 ); + + # forbidden code in [] + eval { my $x = pack( 'A[@4]', 'XXXX' ); }; + like( $@, qr{Within \[\]-length '\@' not allowed} ); + + # @ repeat default 1 + my $s = pack( 'AA@A', 'A', 'B', 'C' ); + my @c = unpack( 'AA@A', $s ); + is( $s, 'AC' ); + is( "@c", "A C C" ); + + # no unpack code after / + eval { my @a = unpack( "C/", "\3" ); }; + like( $@, qr{Code missing after '/'} ); + +} + { # Repeat count [SUBEXPR] my @codes = qw( x A Z a c C B b H h s v n S i I l V N L p P f F d s! S! i! I! l! L! j J); @@ -939,7 +1038,7 @@ numbers ('F', -(2**34), -1, 0, 1, 2**34); SKIP: { my $t = eval { unpack("D*", pack("D", 12.34)) }; - skip "Long doubles not in use", 56 if $@ =~ /Invalid type in pack/; + skip "Long doubles not in use", 56 if $@ =~ /Invalid type/; is(length(pack("D", 0)), $Config{longdblsize}); numbers ('D', -(2**34), -1, 0, 1, 2**34); @@ -953,7 +1052,7 @@ foreach my $template (qw(A Z c C s S i I l L n N v V q Q j J f d F D u U w)) { SKIP: { my $packed = eval {pack "${template}4", 1, 4, 9, 16}; if ($@) { - die unless $@ =~ /Invalid type in pack: '$template'/; + die unless $@ =~ /Invalid type '$template'/; skip ("$template not supported on this perl", $cant_checksum{$template} ? 4 : 8); } -- cgit v1.2.1 From f9b9d3d602f1928e77e0ee656b078cbea0c8bae8 Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Tue, 18 Mar 2003 00:52:09 +0000 Subject: add tests for existing behaviour of undef postinc/dec p4raw-id: //depot/perl@19016 --- t/op/inc.t | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/inc.t b/t/op/inc.t index f360c031fe..56d27d20a5 100755 --- a/t/op/inc.t +++ b/t/op/inc.t @@ -2,7 +2,7 @@ # use strict; -print "1..24\n"; +print "1..26\n"; my $test = 1; @@ -87,6 +87,12 @@ $b = -$a; $b=$b-1; ok ($b == -(++$a), $a); +$a = undef; +ok ($a++ eq '0', do { $a=undef; $a++ }, "postinc undef returns '0'"); + +$a = undef; +ok (!defined($a--), do { $a=undef; $a-- }, "postdec undef returns undef"); + # Verify that shared hash keys become unshared. sub check_same { -- cgit v1.2.1 From 5023d17a8090433133a90a5ff33272f2f429614f Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Tue, 18 Mar 2003 21:55:05 +0000 Subject: [perl #9990] avoid goto &tmpsub coredump Message-ID: <20030318215505.A16787@fdgroup.com> p4raw-id: //depot/perl@19025 --- t/op/goto.t | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/goto.t b/t/op/goto.t index 122c624324..5b30dc5f41 100755 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -2,7 +2,7 @@ # "This IS structured code. It's just randomly structured." -print "1..27\n"; +print "1..28\n"; while ($?) { $foo = 1; @@ -177,6 +177,14 @@ print ($ok ? "ok 22\n" : "not ok 22\n"); print "ok 27 - weird case of goto and for(;;) loop\n"; } +# bug #9990 - don't prematurely free the CV we're &going to. + +sub f1 { + my $x; + goto sub { $x; print "ok 28 - don't prematurely free CV\n" } +} +f1(); + exit; bypass: -- cgit v1.2.1 From ba92458f95420534d366ac8022adf95f17e5b19b Mon Sep 17 00:00:00 2001 From: "Adrian M. Enache" Date: Fri, 21 Mar 2003 00:39:06 +0200 Subject: Re: [patch] [perl #21628] rcatline issue Message-ID: <20030320203906.GA31199@ratsnest.hole> p4raw-id: //depot/perl@19039 --- t/op/readline.t | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/readline.t b/t/op/readline.t index ae043123da..1bc9ef44f7 100644 --- a/t/op/readline.t +++ b/t/op/readline.t @@ -6,8 +6,15 @@ BEGIN { require './test.pl'; } -plan tests => 1; +plan tests => 3; eval { for (\2) { $_ = } }; like($@, 'Modification of a read-only value attempted', '[perl #19566]'); +{ + open A,"+>a"; $a = 3; + is($a .= , 3, '#21628 - $a .= , A eof'); + close A; $a = 4; + is($a .= , 4, '#21628 - $a .= , A closed'); + unlink "a"; +} -- cgit v1.2.1