From 14ebb1a2c3090470663d3e2baaf3787edad7c9a7 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 18 Apr 2003 19:28:04 +0000 Subject: UTF8 regexp patch from Inaba Hiroto. p4raw-id: //depot/perl@19264 --- t/op/pat.t | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 't') diff --git a/t/op/pat.t b/t/op/pat.t index 26e859435f..006e1b600f 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -6,7 +6,7 @@ $| = 1; -print "1..997\n"; +print "1..998\n"; BEGIN { chdir 't' if -d 't'; @@ -3166,4 +3166,10 @@ ok("bbbbac" =~ /$pattern/ && $1 eq 'a', "[perl #3547]"); "[perl #17757] Parse::RecDescent triggers infinite loop"); } -# last test 997 +{ + my $re = qq/^([^X]*)X/; + utf8::upgrade($re); + ok("\x{100}X" =~ /$re/, "S_cl_and ANYOF_UNICODE & ANYOF_INVERTED"); +} + +# last test 998 -- cgit v1.2.1 From bfe0b8460c5710ac333ad9f60968a82600193679 Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Thu, 17 Apr 2003 12:18:19 -0500 Subject: readline.t tweak for VMS From: "Craig A. Berry" Message-ID: <3E9F282B.6090603@mac.com> p4raw-id: //depot/perl@19267 --- t/op/readline.t | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 't') diff --git a/t/op/readline.t b/t/op/readline.t index d127d583a5..80932c441d 100644 --- a/t/op/readline.t +++ b/t/op/readline.t @@ -20,21 +20,23 @@ like($@, 'Modification of a read-only value attempted', '[perl #19566]'); } # 82 is chosen to exceed the length for sv_grow in do_readline (80) -foreach my $k ('k', 'k'x82) { +foreach my $k (1, 82) { my $result = runperl (switches => '-l', stdin => '', stderr => 1, - prog => "%a = qw($k v); \$_ = <> foreach keys %a; print qw(end)", + prog => "\$x = q(k) x $k; \$a{\$x} = qw(v); \$_ = <> foreach keys %a; print qw(end)", ); - is ($result, "end", '[perl #21614] for length ' . length $k); + $result =~ s/\n\z// if $^O eq 'VMS'; + is ($result, "end", '[perl #21614] for length ' . length('k' x $k)); } -foreach my $k ('perl', 'perl'x21) { +foreach my $k (1, 21) { my $result = runperl (switches => '-l', stdin => ' rules', stderr => 1, - prog => "%a = qw($k v); foreach (keys %a) {\$_ .= <>; print}", + prog => "\$x = q(perl) x $k; \$a{\$x} = q(v); foreach (keys %a) {\$_ .= <>; print}", ); - is ($result, "$k rules", 'rcatline to shared sv for length ' . length $k); + $result =~ s/\n\z// if $^O eq 'VMS'; + is ($result, ('perl' x $k) . " rules", 'rcatline to shared sv for length ' . length('perl' x $k)); } foreach my $l (1, 82) { -- cgit v1.2.1 From dd28f7bb7eebdb0b562c940b3c4f89457e829ea6 Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Mon, 7 Apr 2003 11:00:41 +0100 Subject: allow recursive FETCHes Message-ID: <20030407100041.A1617@fdgroup.com> p4raw-id: //depot/perl@19268 --- t/op/tie.t | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) (limited to 't') diff --git a/t/op/tie.t b/t/op/tie.t index 49c189e66f..d643b78282 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -295,3 +295,34 @@ tie $a, 'main'; print $a; EXPECT Tied variable freed while still in use at - line 6. +######## + +# [20020716.007] - nested FETCHES + +sub F1::TIEARRAY { bless [], 'F1' } +sub F1::FETCH { 1 } +my @f1; +tie @f1, 'F1'; + +sub F2::TIEARRAY { bless [2], 'F2' } +sub F2::FETCH { my $self = shift; my $x = $f1[3]; $self } +my @f2; +tie @f2, 'F2'; + +print $f2[4][0],"\n"; + +sub F3::TIEHASH { bless [], 'F3' } +sub F3::FETCH { 1 } +my %f3; +tie %f3, 'F3'; + +sub F4::TIEHASH { bless [3], 'F4' } +sub F4::FETCH { my $self = shift; my $x = $f3{3}; $self } +my %f4; +tie %f4, 'F4'; + +print $f4{'foo'}[0],"\n"; + +EXPECT +2 +3 -- cgit v1.2.1 From abc667d141be9d100fa9e0402f7809147d1f69b9 Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Sat, 19 Apr 2003 21:06:51 +0100 Subject: Re: [PATCH] [perl #21875] Hash ref transformed as a list Message-ID: <20030419190651.GD13333@fdgroup.com> p4raw-id: //depot/perl@19276 --- t/comp/parser.t | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/comp/parser.t b/t/comp/parser.t index 54ad351eb1..b50d8af29d 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -9,7 +9,7 @@ BEGIN { } require "./test.pl"; -plan( tests => 21 ); +plan( tests => 37 ); eval '%@x=0;'; like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' ); @@ -97,3 +97,23 @@ print "#"; print( $data{foo}); pass(); + +# Bug #21875 +# { q.* => ... } should be interpreted as hash, not block + +foreach my $line (split /\n/, <<'EOF') +1 { foo => 'bar' } +1 { qoo => 'bar' } +1 { q => 'bar' } +1 { qq => 'bar' } +0 { q,'bar', } +0 { q=bar= } +0 { qq=bar= } +1 { q=bar= => 'bar' } +EOF +{ + my ($expect, $eval) = split / /, $line, 2; + my $result = eval $eval; + ok($@ eq '', "eval $eval"); + is(ref $result, $expect ? 'HASH' : '', $eval); +} -- cgit v1.2.1 From 39cff0d9bacec3b7c45b12560665095ba3be16b2 Mon Sep 17 00:00:00 2001 From: "Adrian M. Enache" Date: Wed, 2 Apr 2003 08:02:42 +0300 Subject: Fix bug #21347 (segfault in UNIVERSAL::AUTOLOAD with qr//) by adding a dummy destructor method Regexp::DESTROY. This prevents infinite recursion, since Regexp::DESTROY is no more autoloaded. Subject: Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD Message-ID: <20030402020242.GA2966@ratsnest.hole> p4raw-id: //depot/perl@19277 --- t/op/ref.t | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/ref.t b/t/op/ref.t index 9470efa69a..ae3eef7dbf 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); } -print "1..65\n"; +print "1..66\n"; require 'test.pl'; @@ -340,6 +340,12 @@ if ($result eq $expect) { print "# expected \"$expect\", got \"$result\"\n"; } +# bug #21347 + +runperl(prog => 'sub UNIVERSAL::AUTOLOAD { qr// } a->p' ); +if ($? != 0) { print "not " }; +print "ok ",++$test," - UNIVERSAL::AUTOLOAD called when freeing qr//\n"; + # test global destruction ++$test; -- cgit v1.2.1 From 15b61c98f82f3010e6eaa852f9fa5251de9e6dd9 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Mon, 21 Apr 2003 06:50:42 +0000 Subject: Introduce two new Configure symbols: [1] d_faststdio = d_stdstdio && d_stdio_ptr_lval && (d_stdio_cnt_lval || d_stdio_ptr_lval_sets_cnt) [2] usefaststdio = do we use fast stdio if we have it? For 5.[68], we do. For anything else, we don't. (At least, unless otherwise instructed by -Dusefaststdio.) This means that for bleadperl we no more use stdio, but instead default to perlio: the effect of PERLIO=perlio, in other words. (PERLIO=stdio will still switch to using stdio.) This change may endanger extensions using FILE*-- but if we are to migrate fully to perlio, better start swallowing the poison now. For maintperl, the usefaststdio still defaults to yes. p4raw-id: //depot/perl@19286 --- t/io/layers.t | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 't') diff --git a/t/io/layers.t b/t/io/layers.t index 0e733ad994..9a58de2a68 100644 --- a/t/io/layers.t +++ b/t/io/layers.t @@ -25,12 +25,8 @@ plan tests => 43; use Config; my $DOSISH = $^O =~ /^(?:MSWin32|cygwin|os2|dos|NetWare|mint)$/ ? 1 : 0; -my $NONSTDIO = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio' ? 1 : 0; -my $FASTSTDIO = - $Config{d_stdstdio} && - $Config{d_stdio_ptr_lval} && - ($Config{d_stdio_cnt_lval} || - $Config{d_stdio_ptr_lval_sets_cnt}) ? 1 : 0; +my $NONSTDIO = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio' ? 1 : 0; +my $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio} ? 1 : 0; print <<__EOH__; # PERLIO = $PERLIO -- cgit v1.2.1 From 7b102d90616d2574b3c6a3d1942fcb59fc2aaefb Mon Sep 17 00:00:00 2001 From: "Adrian M. Enache" Date: Sun, 20 Apr 2003 05:45:48 +0300 Subject: Fix another segfault case (warn called from UNIVERSAL::DESTROY). Subject: Re: [perl #21347] segfault in UNIVERSAL::AUTOLOAD Date: Sun, 20 Apr 2003 02:45:48 +0300 Message-ID: <20030419234548.GA849@ratsnest.hole> and Date: Wed, 2 Apr 2003 07:52:28 +0300 Message-ID: <20030402045227.GA1023@ratsnest.hole> p4raw-id: //depot/perl@19300 --- t/op/ref.t | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/ref.t b/t/op/ref.t index ae3eef7dbf..b29dcb77ac 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); } -print "1..66\n"; +print "1..67\n"; require 'test.pl'; @@ -346,6 +346,10 @@ runperl(prog => 'sub UNIVERSAL::AUTOLOAD { qr// } a->p' ); if ($? != 0) { print "not " }; print "ok ",++$test," - UNIVERSAL::AUTOLOAD called when freeing qr//\n"; +runperl(prog => 'sub UNIVERSAL::DESTROY { warn } bless \$a, A', stderr => 1); +if ($? != 0) { print "not " }; +print "ok ",++$test," - warn called inside UNIVERSAL::DESTROY\n"; + # test global destruction ++$test; -- cgit v1.2.1 From e29b014fa51391791d8a811bc7d80374cc62e804 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Wed, 23 Apr 2003 08:34:33 +0000 Subject: Handle the combination of dosish and non-faststdio. p4raw-id: //depot/perl@19310 --- t/io/layers.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 't') diff --git a/t/io/layers.t b/t/io/layers.t index 9a58de2a68..86712b3a9a 100644 --- a/t/io/layers.t +++ b/t/io/layers.t @@ -63,7 +63,7 @@ SKIP: { } else { $expected->[0] = $ENV{PERLIO} if $expected->[0] eq "stdio"; } - } elsif (!$FASTSTDIO) { + } elsif (!$FASTSTDIO && !$DOSISH) { splice(@$result, 0, 2, "stdio") if @$result >= 2 && $result->[0] eq "unix" && -- cgit v1.2.1 From cccede5366275457276b68bb148b7872098aaf29 Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Mon, 21 Apr 2003 14:19:50 +0100 Subject: A new fatal error : Subject: [PATCH] Perl_croak("Use of freed value in iteration") Message-ID: <20030421121950.GB18189@fdgroup.com> Message-ID: <20030421125433.GC18189@fdgroup.com> p4raw-id: //depot/perl@19316 --- t/cmd/for.t | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/cmd/for.t b/t/cmd/for.t index 3275c71d2a..3a4bc9b0da 100755 --- a/t/cmd/for.t +++ b/t/cmd/for.t @@ -1,6 +1,6 @@ #!./perl -print "1..12\n"; +print "1..13\n"; for ($i = 0; $i <= 10; $i++) { $x[$i] = $i; @@ -71,3 +71,8 @@ for ("-3" .. "0") { $loop_count++; } print $loop_count == 4 ? "ok" : "not ok", " 12\n"; + +# modifying arrays in loops is a no-no +@a = (3,4); +eval { @a = () for (1,2,@a) }; +print $@ =~ /Use of freed value in iteration/ ? "ok" : "not ok", " 13\n"; -- cgit v1.2.1 From f0fd62e239deb6bdb9f12a7e8ad137e5e1083e2a Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Fri, 25 Apr 2003 04:45:05 +0000 Subject: Clarify(?) the perlio default layers table. p4raw-id: //depot/perl@19327 --- t/io/layers.t | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 't') diff --git a/t/io/layers.t b/t/io/layers.t index 86712b3a9a..8f70392434 100644 --- a/t/io/layers.t +++ b/t/io/layers.t @@ -44,15 +44,15 @@ SKIP: { # An interesting dance follows where we try to make the following # IO layer stack setups to compare equal: # - # PERLIO UNIX-like DOS-like + # PERLIO UNIX-like DOS-like # - # none or "" stdio [1] unix crlf - # stdio stdio [1] stdio - # perlio unix perlio unix perlio - # mmap unix mmap unix mmap + # unset / "" unix perlio / stdio [1] unix crlf + # stdio unix perlio / stdio [1] stdio + # perlio unix perlio unix perlio + # mmap unix mmap unix mmap # - # [1] If Configure found how to do "fast stdio", - # otherwise it will be "unix perlio". + # [1] "stdio" if Configure found out how to do "fast stdio" (depends + # on the stdio implementation) and in Perl 5.8, otherwise "unix perlio" # if ($NONSTDIO) { # Get rid of "unix". -- cgit v1.2.1 From db37a92e82b89bddd13b884e84f66b3fa0b4de08 Mon Sep 17 00:00:00 2001 From: Jarkko Hietaniemi Date: Sun, 27 Apr 2003 08:13:34 +0000 Subject: Add a test case for [perl #15288] (already solved). p4raw-id: //depot/perl@19351 --- t/op/pack.t | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 't') diff --git a/t/op/pack.t b/t/op/pack.t index d3be738b29..0c7d51d73a 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 5849; +plan tests => 5852; use strict; use warnings; @@ -1100,3 +1100,11 @@ ok(pack('u2', 'AA'), "[perl #8026]"); # used to hang and eat RAM in perl 5.7.2 $_ = pack('c', 65); # 'A' would not be EBCDIC-friendly is(unpack('c'), 65, "one-arg unpack (change #18751)"); # defaulting to $_ + +{ + my $a = "X\t01234567\n" x 100; + my @a = unpack("(a1 c/a)*", $a); + is(scalar @a, 200, "[perl #15288]"); + is($a[-1], "01234567\n", "[perl #15288]"); + is($a[-2], "X", "[perl #15288]"); +} -- cgit v1.2.1