r67155 - in /branches/upstream/libautovivification-perl/current: ./ lib/ samples/ t/ t/lib/autovivification/TestRequired4/ t/lib/autovivification/TestRequired5/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Jan 8 17:30:54 UTC 2011
Author: jawnsy-guest
Date: Sat Jan 8 17:30:37 2011
New Revision: 67155
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=67155
Log:
[svn-upgrade] new version libautovivification-perl (0.09)
Added:
branches/upstream/libautovivification-perl/current/t/43-peep.t
Modified:
branches/upstream/libautovivification-perl/current/Changes
branches/upstream/libautovivification-perl/current/MANIFEST
branches/upstream/libautovivification-perl/current/META.yml
branches/upstream/libautovivification-perl/current/Makefile.PL
branches/upstream/libautovivification-perl/current/README
branches/upstream/libautovivification-perl/current/autovivification.xs
branches/upstream/libautovivification-perl/current/lib/autovivification.pm
branches/upstream/libautovivification-perl/current/samples/bench.pl
branches/upstream/libautovivification-perl/current/samples/hash2array.pl
branches/upstream/libautovivification-perl/current/t/24-hash-numerous.t
branches/upstream/libautovivification-perl/current/t/40-scope.t
branches/upstream/libautovivification-perl/current/t/42-deparse.t
branches/upstream/libautovivification-perl/current/t/50-threads.t
branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm
branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm
Modified: branches/upstream/libautovivification-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/Changes?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/Changes (original)
+++ branches/upstream/libautovivification-perl/current/Changes Sat Jan 8 17:30:37 2011
@@ -1,4 +1,14 @@
Revision history for autovivification
+
+0.09 2011-01-05 18:40 UTC
+ + Fix : [RT #64435] : Hangs with File::Copy in Config.pm.
+ This was actually a regression introduced together with the new
+ peephole optimizer strategy, and that caused the pragma to hang
+ on constructs like "for (;;) { ... }".
+ Thanks Michael Schilli for reporting.
+
+0.08 2011-01-03 21:00 UTC
+ + Fix : Building on Windows.
0.07 2010-12-31 16:20 UTC
+ Chg : perl 5.8.3 is required.
Modified: branches/upstream/libautovivification-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/MANIFEST?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/MANIFEST (original)
+++ branches/upstream/libautovivification-perl/current/MANIFEST Sat Jan 8 17:30:37 2011
@@ -22,6 +22,7 @@
t/40-scope.t
t/41-padsv.t
t/42-deparse.t
+t/43-peep.t
t/50-threads.t
t/51-threads-teardown.t
t/91-pod.t
Modified: branches/upstream/libautovivification-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/META.yml?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/META.yml (original)
+++ branches/upstream/libautovivification-perl/current/META.yml Sat Jan 8 17:30:37 2011
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: autovivification
-version: 0.07
+version: 0.09
abstract: Lexically disable autovivification.
author:
- Vincent Pit <perl at profvince.com>
Modified: branches/upstream/libautovivification-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/Makefile.PL?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/Makefile.PL (original)
+++ branches/upstream/libautovivification-perl/current/Makefile.PL Sat Jan 8 17:30:37 2011
@@ -8,7 +8,7 @@
local $@;
eval { require Config };
die 'OS unsupported' if $@;
- Config->import(qw/%Config/);
+ Config->import(qw<%Config>);
}
my @DEFINES;
@@ -17,15 +17,15 @@
my $is_gcc_34 = 0;
print "Checking if this is gcc 3.4 on Windows trying to link against an import library... ";
if ($^O eq 'MSWin32' and not grep /^LD[A-Z]*=/, @ARGV) {
- my ($libperl, $gccversion) = map $_ || '', @Config{qw/libperl gccversion/};
+ my ($libperl, $gccversion) = map $_ || '', @Config{qw<libperl gccversion>};
if ($gccversion =~ /^3\.4\.[0-9]+/ and $libperl =~ s/\.lib$//) {
$is_gcc_34 = 1;
- my ($lddlflags, $ldflags) = @Config{qw/lddlflags ldflags/};
+ my ($lddlflags, $ldflags) = @Config{qw<lddlflags ldflags>};
$_ ||= '', s/-L(?:".*?"|\S+)//g for $lddlflags, $ldflags;
$libperl = "-l$libperl";
my $libdirs = join ' ',
map { s/(?<!\\)((?:\\\\)*")/\\$1/g; qq[-L"$_"] }
- @Config{qw/bin sitebin/};
+ @Config{qw<bin sitebin>};
$macro{LDDLFLAGS} = "$lddlflags $libdirs $libperl";
$macro{LDFLAGS} = "$ldflags $libdirs $libperl";
$macro{PERL_ARCHIVE} = '',
Modified: branches/upstream/libautovivification-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/README?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/README (original)
+++ branches/upstream/libautovivification-perl/current/README Sat Jan 8 17:30:37 2011
@@ -2,7 +2,7 @@
autovivification - Lexically disable autovivification.
VERSION
- Version 0.07
+ Version 0.09
SYNOPSIS
no autovivification;
@@ -105,7 +105,7 @@
Each call to "unimport" adds the specified features to the ones already
in use in the current lexical scope.
- When @opts is empty, it defaults to "qw/fetch exists delete/".
+ When @opts is empty, it defaults to "qw<fetch exists delete>".
"import @opts"
Magically called when "use autovivification @opts" is encountered.
@@ -172,7 +172,7 @@
Matt S. Trout asked for it.
COPYRIGHT & LICENSE
- Copyright 2009,2010 Vincent Pit, all rights reserved.
+ Copyright 2009,2010,2011 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
Modified: branches/upstream/libautovivification-perl/current/autovivification.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/autovivification.xs?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/autovivification.xs (original)
+++ branches/upstream/libautovivification-perl/current/autovivification.xs Sat Jan 8 17:30:37 2011
@@ -107,18 +107,15 @@
#endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
-#if !A_HAS_RPEEP
-
#define PTABLE_NAME ptable_seen
#define PTABLE_VAL_FREE(V) NOOP
#include "ptable.h"
-#endif /* !A_HAS_RPEEP */
-
-#define A_NEED_CXT ((A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION) || !A_HAS_RPEEP)
-
-#if A_NEED_CXT
+/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
+#define ptable_seen_store(T, K, V) ptable_seen_store(aPTBLMS_ (T), (K), (V))
+#define ptable_seen_clear(T) ptable_seen_clear(aPTBLMS_ (T))
+#define ptable_seen_free(T) ptable_seen_free(aPTBLMS_ (T))
#define MY_CXT_KEY __PACKAGE__ "::_guts" XS_VERSION
@@ -127,9 +124,7 @@
ptable *tbl; /* It really is a ptable_hints */
tTHX owner;
#endif /* A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION */
-#if !A_HAS_RPEEP
ptable *seen; /* It really is a ptable_seen */
-#endif /* !A_HAS_RPEEP */
} my_cxt_t;
START_MY_CXT
@@ -185,14 +180,10 @@
#if A_WORKAROUND_REQUIRE_PROPAGATION
ptable_hints_free(MY_CXT.tbl);
#endif /* A_WORKAROUND_REQUIRE_PROPAGATION */
-#if !A_HAS_RPEEP
ptable_seen_free(MY_CXT.seen);
-#endif /* !A_HAS_RPEEP */
}
#endif /* A_THREADSAFE */
-
-#endif /* A_NEED_CXT */
#if A_WORKAROUND_REQUIRE_PROPAGATION
@@ -243,19 +234,19 @@
STATIC SV *a_tag(pTHX_ UV bits) {
#define a_tag(B) a_tag(aTHX_ (B))
a_hint_t *h;
-#if A_THREADSAFE
- dMY_CXT;
-#endif
h = PerlMemShared_malloc(sizeof *h);
h->bits = bits;
h->require_tag = a_require_tag();
#if A_THREADSAFE
- /* We only need for the key to be an unique tag for looking up the value later.
- * Allocated memory provides convenient unique identifiers, so that's why we
- * use the hint as the key itself. */
- ptable_hints_store(MY_CXT.tbl, h, h);
+ {
+ dMY_CXT;
+ /* We only need for the key to be an unique tag for looking up the value later
+ * Allocated memory provides convenient unique identifiers, so that's why we
+ * use the hint as the key itself. */
+ ptable_hints_store(MY_CXT.tbl, h, h);
+ }
#endif /* A_THREADSAFE */
return newSViv(PTR2IV(h));
@@ -264,16 +255,16 @@
STATIC UV a_detag(pTHX_ const SV *hint) {
#define a_detag(H) a_detag(aTHX_ (H))
a_hint_t *h;
-#if A_THREADSAFE
- dMY_CXT;
-#endif
if (!(hint && SvIOK(hint)))
return 0;
h = INT2PTR(a_hint_t *, SvIVX(hint));
#if A_THREADSAFE
- h = ptable_fetch(MY_CXT.tbl, h);
+ {
+ dMY_CXT;
+ h = ptable_fetch(MY_CXT.tbl, h);
+ }
#endif /* A_THREADSAFE */
if (a_require_tag() != h->require_tag)
@@ -352,6 +343,7 @@
/* PerlMemShared_free() needs the [ap]PTBLMS_? default values */
#define ptable_map_store(T, K, V) ptable_map_store(aPTBLMS_ (T), (K), (V))
+#define ptable_map_delete(T, K) ptable_map_delete(aPTBLMS_ (T), (K))
STATIC ptable *a_op_map = NULL;
@@ -941,33 +933,19 @@
STATIC peep_t a_old_peep = 0; /* This is actually the rpeep past 5.13.5 */
-#if !A_HAS_RPEEP
-# define A_PEEP_REC_PROTO STATIC void a_peep_rec(pTHX_ OP *o, ptable *seen)
-#else /* !A_HAS_RPEEP */
-# define A_PEEP_REC_PROTO STATIC void a_peep_rec(pTHX_ OP *o)
-#endif /* A_HAS_RPEEP */
-
-A_PEEP_REC_PROTO;
-A_PEEP_REC_PROTO {
-#if !A_HAS_RPEEP
-# define a_peep_rec(O) a_peep_rec(aTHX_ (O), seen)
-#else /* !A_HAS_RPEEP */
-# define a_peep_rec(O) a_peep_rec(aTHX_ (O))
-#endif /* A_HAS_RPEEP */
- dA_MAP_THX;
-
-#if !A_HAS_RPEEP
- if (ptable_fetch(seen, o))
- return;
-#endif
-
+STATIC void a_peep_rec(pTHX_ OP *o, ptable *seen);
+
+STATIC void a_peep_rec(pTHX_ OP *o, ptable *seen) {
+#define a_peep_rec(O) a_peep_rec(aTHX_ (O), seen)
for (; o; o = o->op_next) {
+ dA_MAP_THX;
const a_op_info *oi = NULL;
UV flags = 0;
-#if !A_HAS_RPEEP
+ if (ptable_fetch(seen, o))
+ break;
ptable_seen_store(seen, o, o);
-#endif
+
switch (o->op_type) {
case OP_PADSV:
if (o->op_ppaddr != a_pp_deref) {
@@ -1052,15 +1030,14 @@
}
STATIC void a_peep(pTHX_ OP *o) {
-#if !A_HAS_RPEEP
dMY_CXT;
ptable *seen = MY_CXT.seen;
+ a_old_peep(aTHX_ o);
+
ptable_seen_clear(seen);
-#endif /* !A_HAS_RPEEP */
-
- a_old_peep(aTHX_ o);
a_peep_rec(o);
+ ptable_seen_clear(seen);
}
/* --- Interpreter setup/teardown ------------------------------------------ */
@@ -1077,17 +1054,13 @@
return;
#endif
-#if A_NEED_CXT
{
dMY_CXT;
# if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
ptable_hints_free(MY_CXT.tbl);
# endif /* A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION */
-# if !A_HAS_RPEEP
ptable_seen_free(MY_CXT.seen);
-# endif /* !A_HAS_RPEEP */
- }
-#endif /* A_NEED_CXT */
+ }
PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_old_ck_padany);
a_old_ck_padany = 0;
@@ -1135,18 +1108,14 @@
if (a_initialized)
return;
-#if A_NEED_CXT
{
MY_CXT_INIT;
# if A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION
MY_CXT.tbl = ptable_new();
MY_CXT.owner = aTHX;
# endif /* A_THREADSAFE && A_WORKAROUND_REQUIRE_PROPAGATION */
-# if !A_HAS_RPEEP
MY_CXT.seen = ptable_new();
-# endif /* !A_RPEEP */
- }
-#endif /* A_NEED_CXT */
+ }
a_old_ck_padany = PL_check[OP_PADANY];
PL_check[OP_PADANY] = MEMBER_TO_FPTR(a_ck_padany);
@@ -1231,7 +1200,7 @@
a_setup();
}
-#if A_THREADSAFE && (A_WORKAROUND_REQUIRE_PROPAGATION || !A_HAS_RPEEP)
+#if A_THREADSAFE
void
CLONE(...)
@@ -1240,9 +1209,7 @@
#if A_WORKAROUND_REQUIRE_PROPAGATION
ptable *t;
#endif
-#if !A_HAS_RPEEP
ptable *s;
-#endif
PPCODE:
{
dMY_CXT;
@@ -1256,9 +1223,7 @@
a_ptable_clone_ud_deinit(ud);
}
#endif
-#if !A_HAS_RPEEP
s = ptable_new();
-#endif
}
{
MY_CXT_CLONE;
@@ -1266,14 +1231,12 @@
MY_CXT.tbl = t;
MY_CXT.owner = aTHX;
#endif
-#if !A_HAS_RPEEP
MY_CXT.seen = s;
-#endif
}
reap(3, a_thread_cleanup, NULL);
XSRETURN(0);
-#endif
+#endif /* A_THREADSAFE */
SV *
_tag(SV *hint)
Modified: branches/upstream/libautovivification-perl/current/lib/autovivification.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/lib/autovivification.pm?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/lib/autovivification.pm (original)
+++ branches/upstream/libautovivification-perl/current/lib/autovivification.pm Sat Jan 8 17:30:37 2011
@@ -11,13 +11,13 @@
=head1 VERSION
-Version 0.07
+Version 0.09
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.07';
+ $VERSION = '0.09';
}
=head1 SYNOPSIS
@@ -132,7 +132,7 @@
Each call to C<unimport> adds the specified features to the ones already in use in the current lexical scope.
-When C<@opts> is empty, it defaults to C<qw/fetch exists delete/>.
+When C<@opts> is empty, it defaults to C<< qw<fetch exists delete> >>.
=cut
@@ -148,7 +148,7 @@
sub unimport {
shift;
my $hint = _detag($^H{+(__PACKAGE__)}) || 0;
- @_ = qw/fetch exists delete/ unless @_;
+ @_ = qw<fetch exists delete> unless @_;
$hint |= $bits{$_} for grep exists $bits{$_}, @_;
$^H |= 0x00020000;
$^H{+(__PACKAGE__)} = _tag($hint);
@@ -234,7 +234,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright 2009,2010 Vincent Pit, all rights reserved.
+Copyright 2009,2010,2011 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Modified: branches/upstream/libautovivification-perl/current/samples/bench.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/samples/bench.pl?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/samples/bench.pl (original)
+++ branches/upstream/libautovivification-perl/current/samples/bench.pl Sat Jan 8 17:30:37 2011
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Benchmark qw/:hireswallclock cmpthese/;
+use Benchmark qw<:hireswallclock cmpthese>;
use blib;
Modified: branches/upstream/libautovivification-perl/current/samples/hash2array.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/samples/hash2array.pl?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/samples/hash2array.pl (original)
+++ branches/upstream/libautovivification-perl/current/samples/hash2array.pl Sat Jan 8 17:30:37 2011
@@ -3,8 +3,8 @@
use strict;
use warnings;
-use Fatal qw/open close/;
-use Text::Balanced qw/extract_bracketed/;
+use Fatal qw<open close>;
+use Text::Balanced qw<extract_bracketed>;
open my $hash_t, '<', 't/20-hash.t';
open my $array_t, '>', 't/30-array.t';
Modified: branches/upstream/libautovivification-perl/current/t/24-hash-numerous.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/24-hash-numerous.t?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/24-hash-numerous.t (original)
+++ branches/upstream/libautovivification-perl/current/t/24-hash-numerous.t Sat Jan 8 17:30:37 2011
@@ -48,7 +48,7 @@
{
my @r;
no autovivification;
- @r = @{$x}{qw/a b/} for 1 .. $n;
+ @r = @{$x}{qw<a b>} for 1 .. $n;
}
is_deeply $x, undef, 'numerous slices from an undef lexical';
@@ -56,7 +56,7 @@
{
my @r;
no autovivification;
- @r = @{$x->{a}}{qw/b c/} for 1 .. $n;
+ @r = @{$x->{a}}{qw<b c>} for 1 .. $n;
}
is_deeply $x, { a => undef }, 'numerous slices from a 1-level hashref lexical';
}
@@ -66,7 +66,7 @@
{
my @r;
no autovivification;
- @r = @{$x}{qw/a b/} for 1 .. $n;
+ @r = @{$x}{qw<a b>} for 1 .. $n;
}
is_deeply $x, undef, 'numerous slices from an undef global';
@@ -74,7 +74,7 @@
{
my @r;
no autovivification;
- @r = @{$x->{a}}{qw/b c/} for 1 .. $n;
+ @r = @{$x->{a}}{qw<b c>} for 1 .. $n;
}
is_deeply $x, { a => undef }, 'numerous slices from a 1-level hashref global';
}
Modified: branches/upstream/libautovivification-perl/current/t/40-scope.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/40-scope.t?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/40-scope.t (original)
+++ branches/upstream/libautovivification-perl/current/t/40-scope.t Sat Jan 8 17:30:37 2011
@@ -12,7 +12,7 @@
my $x;
my $res = eval {
local $SIG{__WARN__} = sub { push @w, join '', 'warn:', @_ };
- no autovivification qw/warn fetch/;
+ no autovivification qw<warn fetch>;
$x->{a};
};
is @w, 1, 'warned only once';
Modified: branches/upstream/libautovivification-perl/current/t/42-deparse.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/42-deparse.t?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/42-deparse.t (original)
+++ branches/upstream/libautovivification-perl/current/t/42-deparse.t Sat Jan 8 17:30:37 2011
@@ -14,7 +14,7 @@
my $bd = B::Deparse->new;
{
- no autovivification qw/fetch strict/;
+ no autovivification qw<fetch strict>;
sub blech { my $key = $_[0]->{key} }
}
Added: branches/upstream/libautovivification-perl/current/t/43-peep.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/43-peep.t?rev=67155&op=file
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/43-peep.t (added)
+++ branches/upstream/libautovivification-perl/current/t/43-peep.t Sat Jan 8 17:30:37 2011
@@ -1,0 +1,198 @@
+#!perl -T
+
+use strict;
+use warnings;
+
+use Test::More tests => 11 + 6 * 3;
+
+{
+ my $desc = 'peephole optimization of conditionals';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ if ($_[0]) {
+ my $z = $x->{a};
+ return 1;
+ } elsif ($_[1] || $_[2]) {
+ my $z = $x->{b};
+ return 2;
+ } elsif ($_[3] && $_[4]) {
+ my $z = $x->{c};
+ return 3;
+ } elsif ($_[5] ? $_[6] : 0) {
+ my $z = $x->{d};
+ return 4;
+ } else {
+ my $z = $x->{e};
+ return 5;
+ }
+ return 0;
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->(1);
+ is_deeply $x, undef, "$desc : first branch did not autovivify";
+ is $ret, 1, "$desc : first branch returned 1";
+
+ $ret = $code->(0, 1);
+ is_deeply $x, undef, "$desc : second branch did not autovivify";
+ is $ret, 2, "$desc : second branch returned 2";
+
+ $ret = $code->(0, 0, 0, 1, 1);
+ is_deeply $x, undef, "$desc : third branch did not autovivify";
+ is $ret, 3, "$desc : third branch returned 3";
+
+ $ret = $code->(0, 0, 0, 0, 0, 1, 1);
+ is_deeply $x, undef, "$desc : fourth branch did not autovivify";
+ is $ret, 4, "$desc : fourth branch returned 4";
+
+ $ret = $code->();
+ is_deeply $x, undef, "$desc : fifth branch did not autovivify";
+ is $ret, 5, "$desc : fifth branch returned 5";
+}
+
+{
+ my $desc = 'peephole optimization of C-style loops';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ my $ret = 0;
+ for (
+ my ($z, $i) = ($x->[100], 0)
+ ;
+ do { my $z = $x->[200]; $i < 4 }
+ ;
+ do { my $z = $x->[300]; ++$i }
+ ) {
+ my $z = $x->[$i];
+ $ret += $i;
+ }
+ return $ret;
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->();
+ is_deeply $x, undef, "$desc did not autovivify";
+ is $ret, 6, "$desc returned 0+1+2+3";
+}
+
+{
+ my $desc = 'peephole optimization of range loops';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ my $ret = 0;
+ for ((do { my $z = $x->[100]; 0 }) .. (do { my $z = $x->[200]; 3 })) {
+ my $z = $x->[$_];
+ $ret += $_;
+ }
+ return $ret;
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->();
+ is_deeply $x, undef, "$desc did not autovivify";
+ is $ret, 6, "$desc returned 0+1+2+3";
+}
+
+{
+ my $desc = 'peephole optimization of empty loops (RT #64435)';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ my $ret = 0;
+ for (;;) {
+ ++$ret;
+ return $ret;
+ }
+ return $ret;
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->();
+ is_deeply $x, undef, "$desc did not autovivify";
+ is $ret, 1, "$desc returned 1";
+}
+
+{
+ my $desc = 'peephole optimization of map';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ join ':', map {
+ my $z = $x->[$_];
+ "x${_}y"
+ } @_
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->(1, 2);
+ is_deeply $x, undef, "$desc did not autovivify";
+ is $ret, 'x1y:x2y', "$desc returned the right value";
+}
+
+{
+ my $desc = 'peephole optimization of grep';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ join ':', grep {
+ my $z = $x->[$_];
+ $_ <= 3
+ } @_
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->(1 .. 5);
+ is_deeply $x, undef, "$desc did not autovivify";
+ is $ret, '1:2:3', "$desc returned the right value";
+}
+
+{
+ my $desc = 'peephole optimization of substitutions';
+ my $x;
+
+ local $@;
+ my $code = eval <<' TESTCASE';
+ no autovivification;
+ sub {
+ my $str = $_[0];
+ $str =~ s{
+ ([0-9])
+ }{
+ my $z = $x->[$1];
+ 9 - $1;
+ }xge;
+ $str;
+ }
+ TESTCASE
+ is $@, '', "$desc compiled fine";
+
+ my $ret = $code->('0123456789');
+ is_deeply $x, undef, "$desc did not autovivify";
+ is $ret, '9876543210', "$desc returned the right value";
+}
Modified: branches/upstream/libautovivification-perl/current/t/50-threads.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/50-threads.t?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/50-threads.t (original)
+++ branches/upstream/libautovivification-perl/current/t/50-threads.t Sat Jan 8 17:30:37 2011
@@ -9,7 +9,7 @@
Test::More::plan(skip_all => $msg);
}
-use Config qw/%Config/;
+use Config qw<%Config>;
BEGIN {
my $force = $ENV{PERL_AUTOVIVIFICATION_TEST_THREADS} ? 1 : !1;
Modified: branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t (original)
+++ branches/upstream/libautovivification-perl/current/t/51-threads-teardown.t Sat Jan 8 17:30:37 2011
@@ -9,7 +9,7 @@
Test::More::plan(skip_all => $msg);
}
-use Config qw/%Config/;
+use Config qw<%Config>;
BEGIN {
my $force = $ENV{PERL_AUTOVIVIFICATION_TEST_THREADS} ? 1 : !1;
Modified: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm (original)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired4/a0.pm Sat Jan 8 17:30:37 2011
@@ -1,5 +1,5 @@
package autovivification::TestRequired4::a0;
-no autovivification qw/strict fetch/;
+no autovivification qw<strict fetch>;
use autovivification::TestRequired4::b0;
sub error {
local $@;
Modified: branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm?rev=67155&op=diff
==============================================================================
--- branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm (original)
+++ branches/upstream/libautovivification-perl/current/t/lib/autovivification/TestRequired5/a0.pm Sat Jan 8 17:30:37 2011
@@ -1,5 +1,5 @@
package autovivification::TestRequired5::a0;
-no autovivification qw/strict fetch/;
+no autovivification qw<strict fetch>;
use autovivification::TestRequired5::b0;
sub error {
local $@;
More information about the Pkg-perl-cvs-commits
mailing list