r56803 - in /trunk/libindirect-perl: ./ debian/ lib/ t/ t/lib/indirect/TestRequired4/ t/lib/indirect/TestRequired5/
ivan at users.alioth.debian.org
ivan at users.alioth.debian.org
Sun Apr 25 03:59:55 UTC 2010
Author: ivan
Date: Sun Apr 25 03:59:42 2010
New Revision: 56803
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=56803
Log:
New upstream release 0.20
Added:
trunk/libindirect-perl/t/lib/indirect/TestRequired4/
- copied from r56802, branches/upstream/libindirect-perl/current/t/lib/indirect/TestRequired4/
trunk/libindirect-perl/t/lib/indirect/TestRequired5/
- copied from r56802, branches/upstream/libindirect-perl/current/t/lib/indirect/TestRequired5/
Modified:
trunk/libindirect-perl/Changes
trunk/libindirect-perl/MANIFEST
trunk/libindirect-perl/META.yml
trunk/libindirect-perl/Makefile.PL
trunk/libindirect-perl/README
trunk/libindirect-perl/debian/changelog
trunk/libindirect-perl/indirect.xs
trunk/libindirect-perl/lib/indirect.pm
trunk/libindirect-perl/ptable.h
trunk/libindirect-perl/t/30-scope.t
trunk/libindirect-perl/t/41-threads-teardown.t
trunk/libindirect-perl/t/80-regressions.t
trunk/libindirect-perl/t/99-kwalitee.t
Modified: trunk/libindirect-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/Changes?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/Changes (original)
+++ trunk/libindirect-perl/Changes Sun Apr 25 03:59:42 2010
@@ -1,4 +1,13 @@
Revision history for indirect
+
+0.20 2010-04-18 21:25 UTC
+ + Fix : [RT #50570] : "indirect" leaking into LWP.
+ Thanks Andrew Main for reporting.
+ More generally, the require propagation workaround on 5.8-5.10.0
+ has been overhauled, and other scope leaks should be fixed.
+ + Fix : Test failures with 5.12 on Windows where Strawberry Perl crashes
+ because the SystemRoot environment variable is missing.
+ + Fix : Work around Kwalitee test misfailures.
0.19 2009-08-28 18:40 UTC
+ Add : The new constant I_FORKSAFE can be tested to know whether the
Modified: trunk/libindirect-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/MANIFEST?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/MANIFEST (original)
+++ trunk/libindirect-perl/MANIFEST Sun Apr 25 03:59:42 2010
@@ -33,3 +33,10 @@
t/lib/indirect/TestRequired2.pm
t/lib/indirect/TestRequired3X.pm
t/lib/indirect/TestRequired3Y.pm
+t/lib/indirect/TestRequired4/a0.pm
+t/lib/indirect/TestRequired4/b0.pm
+t/lib/indirect/TestRequired4/c0.pm
+t/lib/indirect/TestRequired5/a0.pm
+t/lib/indirect/TestRequired5/b0.pm
+t/lib/indirect/TestRequired5/c0.pm
+t/lib/indirect/TestRequired5/d0.pm
Modified: trunk/libindirect-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/META.yml?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/META.yml (original)
+++ trunk/libindirect-perl/META.yml Sun Apr 25 03:59:42 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: indirect
-version: 0.19
+version: 0.20
abstract: Lexically warn about using the indirect object syntax.
author:
- Vincent Pit <perl at profvince.com>
@@ -11,6 +11,7 @@
build_requires:
ExtUtils::MakeMaker: 0
Test::More: 0
+ XSLoader: 0
requires:
perl: 5.008
XSLoader: 0
@@ -23,7 +24,8 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.54
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
+dynamic_config: 1
Modified: trunk/libindirect-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/Makefile.PL?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/Makefile.PL (original)
+++ trunk/libindirect-perl/Makefile.PL Sun Apr 25 03:59:42 2010
@@ -20,6 +20,15 @@
my $dist = 'indirect';
+(my $name = $dist) =~ s{-}{::}g;
+
+(my $file = $dist) =~ s{-}{/}g;
+$file = "lib/$file.pm";
+
+my %PREREQ_PM = (
+ 'XSLoader' => 0,
+);
+
my %META = (
configure_requires => {
'ExtUtils::MakeMaker' => 0,
@@ -27,7 +36,9 @@
build_requires => {
'ExtUtils::MakeMaker' => 0,
'Test::More' => 0,
+ %PREREQ_PM,
},
+ dynamic_config => 1,
resources => {
bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
homepage => "http://search.cpan.org/dist/$dist/",
@@ -37,23 +48,21 @@
);
WriteMakefile(
- NAME => 'indirect',
- AUTHOR => 'Vincent Pit <perl at profvince.com>',
- LICENSE => 'perl',
- VERSION_FROM => 'lib/indirect.pm',
- ABSTRACT_FROM => 'lib/indirect.pm',
- PL_FILES => {},
- @DEFINES,
- PREREQ_PM => {
- 'XSLoader' => 0,
- },
- MIN_PERL_VERSION => 5.008,
- META_MERGE => \%META,
- dist => {
- PREOP => 'pod2text lib/indirect.pm > $(DISTVNAME)/README',
- COMPRESS => 'gzip -9f', SUFFIX => 'gz'
- },
- clean => {
- FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
- },
+ NAME => $name,
+ AUTHOR => 'Vincent Pit <perl at profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => $file,
+ ABSTRACT_FROM => $file,
+ PL_FILES => {},
+ @DEFINES,
+ PREREQ_PM => \%PREREQ_PM,
+ MIN_PERL_VERSION => 5.008,
+ META_MERGE => \%META,
+ dist => {
+ PREOP => "pod2text $file > \$(DISTVNAME)/README",
+ COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean => {
+ FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
+ },
);
Modified: trunk/libindirect-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/README?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/README (original)
+++ trunk/libindirect-perl/README Sun Apr 25 03:59:42 2010
@@ -2,7 +2,7 @@
indirect - Lexically warn about using the indirect object syntax.
VERSION
- Version 0.19
+ Version 0.20
SYNOPSIS
# In a script
@@ -31,10 +31,14 @@
DESCRIPTION
When enabled (or disabled as some may prefer to say, since you actually
turn it on by calling "no indirect"), this pragma warns about indirect
- object syntax constructs that may have slipped into your code. This
- syntax is now considered harmful, since its parsing has many quirks and
- its use is error prone (when "swoosh" isn't defined, "swoosh $x"
- actually compiles to "$x->swoosh").
+ object syntax constructs that may have slipped into your code.
+
+ This syntax is now considered harmful, since its parsing has many quirks
+ and its use is error prone (when "swoosh" isn't defined, "swoosh $x"
+ actually compiles to "$x->swoosh"). In
+ <http://www.shadowcat.co.uk/blog/matt-s-trout/indirect-but-still-fatal>,
+ Matt S. Trout gives an example of an indirect construct that can cause a
+ particularly bewildering error.
It currently does not warn for core functions ("print", "say", "exec" or
"system"). This may change in the future, or may be added as optional
@@ -147,7 +151,7 @@
reporting issues.
COPYRIGHT & LICENSE
- Copyright 2008-2009 Vincent Pit, all rights reserved.
+ Copyright 2008,2009,2010 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: trunk/libindirect-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/debian/changelog?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/debian/changelog (original)
+++ trunk/libindirect-perl/debian/changelog Sun Apr 25 03:59:42 2010
@@ -1,4 +1,4 @@
-libindirect-perl (0.19-2) UNRELEASED; urgency=low
+libindirect-perl (0.20-1) UNRELEASED; urgency=low
* Take over for the Debian Perl Group
* debian/control: Added: Vcs-Svn field (source stanza); Vcs-Browser
@@ -6,8 +6,9 @@
<pkg-perl-maintainers at lists.alioth.debian.org> (was: Ivan Kohler
<ivan-debian at 420.am>); Ivan Kohler <ivan-debian at 420.am> moved to
Uploaders.
+ * New upstream release
- -- Ivan Kohler <ivan-debian at 420.am> Sat, 24 Apr 2010 20:55:39 -0700
+ -- Ivan Kohler <ivan-debian at 420.am> Sat, 24 Apr 2010 20:58:31 -0700
libindirect-perl (0.19-1) unstable; urgency=low
Modified: trunk/libindirect-perl/indirect.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/indirect.xs?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/indirect.xs (original)
+++ trunk/libindirect-perl/indirect.xs Sun Apr 25 03:59:42 2010
@@ -60,6 +60,20 @@
#endif
#define I_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
+
+#undef ENTERn
+#if defined(ENTER_with_name) && !I_HAS_PERL(5, 11, 4)
+# define ENTERn(N) ENTER_with_name(N)
+#else
+# define ENTERn(N) ENTER
+#endif
+
+#undef LEAVEn
+#if defined(LEAVE_with_name) && !I_HAS_PERL(5, 11, 4)
+# define LEAVEn(N) LEAVE_with_name(N)
+#else
+# define LEAVEn(N) LEAVE
+#endif
#if I_HAS_PERL(5, 10, 0) || defined(PL_parser)
# ifndef PL_lex_inwhat
@@ -141,8 +155,8 @@
#if I_WORKAROUND_REQUIRE_PROPAGATION
typedef struct {
- SV *code;
- I32 requires;
+ SV *code;
+ IV require_tag;
} indirect_hint_t;
#define I_HINT_STRUCT 1
@@ -256,11 +270,12 @@
#if I_HINT_STRUCT
- h2 = PerlMemShared_malloc(sizeof *h2);
- h2->code = indirect_clone(h1->code, ud->owner);
+ h2 = PerlMemShared_malloc(sizeof *h2);
+ h2->code = indirect_clone(h1->code, ud->owner);
SvREFCNT_inc(h2->code);
#if I_WORKAROUND_REQUIRE_PROPAGATION
- h2->requires = h1->requires;
+ h2->require_tag = PTR2IV(indirect_clone(INT2PTR(SV *, h1->require_tag),
+ ud->owner));
#endif
#else /* I_HINT_STRUCT */
@@ -293,6 +308,52 @@
#endif /* I_THREADSAFE */
+#if I_WORKAROUND_REQUIRE_PROPAGATION
+STATIC IV indirect_require_tag(pTHX) {
+#define indirect_require_tag() indirect_require_tag(aTHX)
+ const CV *cv, *outside;
+
+ cv = PL_compcv;
+
+ if (!cv) {
+ /* If for some reason the pragma is operational at run-time, try to discover
+ * the current cv in use. */
+ const PERL_SI *si;
+
+ for (si = PL_curstackinfo; si; si = si->si_prev) {
+ I32 cxix;
+
+ for (cxix = si->si_cxix; cxix >= 0; --cxix) {
+ const PERL_CONTEXT *cx = si->si_cxstack + cxix;
+
+ switch (CxTYPE(cx)) {
+ case CXt_SUB:
+ case CXt_FORMAT:
+ /* The propagation workaround is only needed up to 5.10.0 and at that
+ * time format and sub contexts were still identical. And even later the
+ * cv members offsets should have been kept the same. */
+ cv = cx->blk_sub.cv;
+ goto get_enclosing_cv;
+ case CXt_EVAL:
+ cv = cx->blk_eval.cv;
+ goto get_enclosing_cv;
+ default:
+ break;
+ }
+ }
+ }
+
+ cv = PL_main_cv;
+ }
+
+get_enclosing_cv:
+ for (outside = CvOUTSIDE(cv); outside; outside = CvOUTSIDE(cv))
+ cv = outside;
+
+ return PTR2IV(cv);
+}
+#endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
+
STATIC SV *indirect_tag(pTHX_ SV *value) {
#define indirect_tag(V) indirect_tag(aTHX_ (V))
indirect_hint_t *h;
@@ -309,28 +370,10 @@
#if I_HINT_STRUCT
h = PerlMemShared_malloc(sizeof *h);
- h->code = code;
-
-#if I_WORKAROUND_REQUIRE_PROPAGATION
- {
- const PERL_SI *si;
- I32 requires = 0;
-
- for (si = PL_curstackinfo; si; si = si->si_prev) {
- I32 cxix;
-
- for (cxix = si->si_cxix; cxix >= 0; --cxix) {
- const PERL_CONTEXT *cx = si->si_cxstack + cxix;
-
- if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE)
- ++requires;
- }
- }
-
- h->requires = requires;
- }
-#endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
-
+ h->code = code;
+# if I_WORKAROUND_REQUIRE_PROPAGATION
+ h->require_tag = indirect_require_tag();
+# endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
#else /* I_HINT_STRUCT */
h = code;
#endif /* !I_HINT_STRUCT */
@@ -359,22 +402,8 @@
#endif /* I_THREADSAFE */
#if I_WORKAROUND_REQUIRE_PROPAGATION
- {
- const PERL_SI *si;
- I32 requires = 0;
-
- for (si = PL_curstackinfo; si; si = si->si_prev) {
- I32 cxix;
-
- for (cxix = si->si_cxix; cxix >= 0; --cxix) {
- const PERL_CONTEXT *cx = si->si_cxstack + cxix;
-
- if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_REQUIRE
- && ++requires > h->requires)
- return NULL;
- }
- }
- }
+ if (indirect_require_tag() != h->require_tag)
+ return NULL;
#endif /* I_WORKAROUND_REQUIRE_PROPAGATION */
return I_HINT_CODE(h);
@@ -456,7 +485,6 @@
STATIC const indirect_op_info_t *indirect_map_fetch(pTHX_ const OP *o) {
#define indirect_map_fetch(O) indirect_map_fetch(aTHX_ (O))
- const indirect_op_info_t *val;
dMY_CXT;
if (MY_CXT.linestr != SvPVX_const(PL_linestr))
@@ -894,9 +922,9 @@
{
level = PerlMemShared_malloc(sizeof *level);
*level = 1;
- LEAVE;
+ LEAVEn("sub");
SAVEDESTRUCTOR_X(indirect_thread_cleanup, level);
- ENTER;
+ ENTERn("sub");
}
#endif
Modified: trunk/libindirect-perl/lib/indirect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/lib/indirect.pm?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/lib/indirect.pm (original)
+++ trunk/libindirect-perl/lib/indirect.pm Sun Apr 25 03:59:42 2010
@@ -11,13 +11,13 @@
=head1 VERSION
-Version 0.19
+Version 0.20
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.19';
+ $VERSION = '0.20';
}
=head1 SYNOPSIS
@@ -48,7 +48,9 @@
=head1 DESCRIPTION
When enabled (or disabled as some may prefer to say, since you actually turn it on by calling C<no indirect>), this pragma warns about indirect object syntax constructs that may have slipped into your code.
+
This syntax is now considered harmful, since its parsing has many quirks and its use is error prone (when C<swoosh> isn't defined, C<swoosh $x> actually compiles to C<< $x->swoosh >>).
+In L<http://www.shadowcat.co.uk/blog/matt-s-trout/indirect-but-still-fatal>, Matt S. Trout gives an example of an indirect construct that can cause a particularly bewildering error.
It currently does not warn for core functions (C<print>, C<say>, C<exec> or C<system>).
This may change in the future, or may be added as optional features that would be enabled by passing options to C<unimport>.
@@ -220,7 +222,7 @@
=head1 COPYRIGHT & LICENSE
-Copyright 2008-2009 Vincent Pit, all rights reserved.
+Copyright 2008,2009,2010 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: trunk/libindirect-perl/ptable.h
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/ptable.h?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/ptable.h (original)
+++ trunk/libindirect-perl/ptable.h Sun Apr 25 03:59:42 2010
@@ -70,8 +70,8 @@
#ifndef ptable
typedef struct ptable {
ptable_ent **ary;
- UV max;
- UV items;
+ size_t max;
+ size_t items;
} ptable;
#define ptable ptable
#endif /* !ptable */
@@ -121,9 +121,9 @@
STATIC void ptable_split(pPTBLMS_ ptable * const t) {
#define ptable_split(T) ptable_split(aPTBLMS_ (T))
ptable_ent **ary = t->ary;
- const UV oldsize = t->max + 1;
- UV newsize = oldsize * 2;
- UV i;
+ const size_t oldsize = t->max + 1;
+ size_t newsize = oldsize * 2;
+ size_t i;
ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary));
Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
@@ -156,7 +156,7 @@
PTABLE_VAL_FREE(oldval);
ent->val = val;
} else if (val) {
- const UV i = PTABLE_HASH(key) & t->max;
+ const size_t i = PTABLE_HASH(key) & t->max;
ent = PerlMemShared_malloc(sizeof *ent);
ent->key = key;
ent->val = val;
@@ -173,7 +173,7 @@
#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
if (t && t->items) {
register ptable_ent ** const array = t->ary;
- UV i = t->max;
+ size_t i = t->max;
do {
ptable_ent *entry;
for (entry = array[i]; entry; entry = entry->next)
@@ -186,7 +186,7 @@
STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
if (t && t->items) {
register ptable_ent ** const array = t->ary;
- UV i = t->max;
+ size_t i = t->max;
do {
ptable_ent *entry = array[i];
Modified: trunk/libindirect-perl/t/30-scope.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/t/30-scope.t?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/t/30-scope.t (original)
+++ trunk/libindirect-perl/t/30-scope.t Sun Apr 25 03:59:42 2010
@@ -6,7 +6,7 @@
my $tests;
BEGIN { $tests = 18 }
-use Test::More tests => (1 + $tests + 1) + 3 + 3 + 3 + 5 + 4 + 1;
+use Test::More tests => (1 + $tests + 1) + 3 + 3 + 3 + 5 + 4 + 3;
BEGIN { delete $ENV{PERL_INDIRECT_PM_DISABLE} }
@@ -153,6 +153,20 @@
is $@, '', 'RT #47902';
}
+{
+ my $err = eval <<' SNIP';
+ use indirect::TestRequired4::a0;
+ indirect::TestRequired4::a0::error();
+ SNIP
+ like $err, qr/^Can't locate object method "new" via package "X"/, 'RT #50570';
+}
+
+# This test must be in the topmost scope
+BEGIN { eval 'use indirect::TestRequired5::a0' }
+my $err = indirect::TestRequired5::a0::error();
+like $err, qr/^Can't locate object method "new" via package "X"/,
+ 'identifying requires by their eval context pointer is not enough';
+
__DATA__
my $a = new P1;
Modified: trunk/libindirect-perl/t/41-threads-teardown.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/t/41-threads-teardown.t?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/t/41-threads-teardown.t (original)
+++ trunk/libindirect-perl/t/41-threads-teardown.t Sun Apr 25 03:59:42 2010
@@ -31,7 +31,10 @@
sub run_perl {
my $code = shift;
+ my $SystemRoot = $ENV{SystemRoot};
local %ENV;
+ $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
+
system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
}
Modified: trunk/libindirect-perl/t/80-regressions.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/t/80-regressions.t?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/t/80-regressions.t (original)
+++ trunk/libindirect-perl/t/80-regressions.t Sun Apr 25 03:59:42 2010
@@ -10,7 +10,10 @@
sub run_perl {
my $code = shift;
+ my $SystemRoot = $ENV{SystemRoot};
local %ENV;
+ $ENV{SystemRoot} = $SystemRoot if $^O eq 'MSWin32' and defined $SystemRoot;
+
system { $^X } $^X, '-T', map("-I$_", @INC), '-e', $code;
}
Modified: trunk/libindirect-perl/t/99-kwalitee.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/t/99-kwalitee.t?rev=56803&op=diff
==============================================================================
--- trunk/libindirect-perl/t/99-kwalitee.t (original)
+++ trunk/libindirect-perl/t/99-kwalitee.t Sun Apr 25 03:59:42 2010
@@ -5,5 +5,17 @@
use Test::More;
-eval { require Test::Kwalitee; Test::Kwalitee->import() };
-plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
+eval { require Test::Kwalitee; };
+plan(skip_all => 'Test::Kwalitee not installed') if $@;
+
+SKIP: {
+ eval { Test::Kwalitee->import(); };
+ if (my $err = $@) {
+ 1 while chomp $err;
+ require Test::Builder;
+ my $Test = Test::Builder->new;
+ my $plan = $Test->has_plan;
+ $Test->skip_all($err) if not defined $plan or $plan eq 'no_plan';
+ skip $err => $plan - $Test->current_test;
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list