r63313 - in /trunk/libindirect-perl: Changes MANIFEST META.yml README debian/changelog indirect.xs lib/indirect.pm t/40-threads.t t/41-threads-teardown.t t/47-stress-use.t t/50-external.t t/80-regressions.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Mon Oct 4 15:09:10 UTC 2010
Author: angelabad-guest
Date: Mon Oct 4 15:08:32 2010
New Revision: 63313
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=63313
Log:
New upstream release
Added:
trunk/libindirect-perl/t/47-stress-use.t
- copied unchanged from r63311, branches/upstream/libindirect-perl/current/t/47-stress-use.t
trunk/libindirect-perl/t/50-external.t
- copied unchanged from r63311, branches/upstream/libindirect-perl/current/t/50-external.t
Removed:
trunk/libindirect-perl/t/80-regressions.t
Modified:
trunk/libindirect-perl/Changes
trunk/libindirect-perl/MANIFEST
trunk/libindirect-perl/META.yml
trunk/libindirect-perl/README
trunk/libindirect-perl/debian/changelog
trunk/libindirect-perl/indirect.xs
trunk/libindirect-perl/lib/indirect.pm
trunk/libindirect-perl/t/40-threads.t
trunk/libindirect-perl/t/41-threads-teardown.t
Modified: trunk/libindirect-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/Changes?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/Changes (original)
+++ trunk/libindirect-perl/Changes Mon Oct 4 15:08:32 2010
@@ -1,4 +1,15 @@
Revision history for indirect
+
+0.23 2010-10-03 00:15 UTC
+ + Fix : Some indirect constructs could be incorrectly reported when
+ several modules were used in the same scope. This caused
+ t/30-scope.t to fail randomly.
+ + Tst : Threads tests are now only run on perl 5.13.4 and higher.
+ They could segfault randomly because of what seems to be an
+ internal bug of Perl, which has been addressed in 5.13.4.
+ There is also an environment variable that allows you to
+ forcefully run those tests, but it should be set only for
+ author testing and not for end users.
0.22 2010-08-16 16:00 UTC
+ Add : Indirect constructs are now reported for code interpolated
Modified: trunk/libindirect-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/MANIFEST?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/MANIFEST (original)
+++ trunk/libindirect-perl/MANIFEST Mon Oct 4 15:08:32 2010
@@ -21,7 +21,8 @@
t/41-threads-teardown.t
t/45-memory.t
t/46-stress.t
-t/80-regressions.t
+t/47-stress-use.t
+t/50-external.t
t/91-pod.t
t/92-pod-coverage.t
t/95-portability-files.t
Modified: trunk/libindirect-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/META.yml?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/META.yml (original)
+++ trunk/libindirect-perl/META.yml Mon Oct 4 15:08:32 2010
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: indirect
-version: 0.22
+version: 0.23
abstract: Lexically warn about using the indirect object syntax.
author:
- Vincent Pit <perl at profvince.com>
Modified: trunk/libindirect-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/README?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/README (original)
+++ trunk/libindirect-perl/README Mon Oct 4 15:08:32 2010
@@ -2,7 +2,7 @@
indirect - Lexically warn about using the indirect object syntax.
VERSION
- Version 0.22
+ Version 0.23
SYNOPSIS
# In a script
@@ -108,9 +108,11 @@
"perl 5.8.x-5.10.0" bug that causes all pragmas to propagate into
"require"d scopes.
- "meth $obj" (no semicolon) at the end of a file won't be seen as an
- indirect object syntax, although it will as soon as there is another
- token before the end (as in "meth $obj;" or "meth $obj 1").
+ Before "perl" 5.12, "meth $obj" (no semicolon) at the end of a file is
+ not seen as an indirect object syntax, although it is as soon as there
+ is another token before the end (as in "meth $obj;" or "meth $obj 1").
+ If you use "perl" 5.12 or greater, those constructs are correctly
+ reported.
With 5.8 perls, the pragma does not propagate into "eval STRING". This
is due to a shortcoming in the way perl handles the hints hash, which is
Modified: trunk/libindirect-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/debian/changelog?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/debian/changelog (original)
+++ trunk/libindirect-perl/debian/changelog Mon Oct 4 15:08:32 2010
@@ -1,3 +1,9 @@
+libindirect-perl (0.23-1) unstable; urgency=low
+
+ * New upstream release
+
+ -- Angel Abad <angelabad at gmail.com> Mon, 04 Oct 2010 17:05:00 +0200
+
libindirect-perl (0.22-1) unstable; urgency=low
* New upstream release
Modified: trunk/libindirect-perl/indirect.xs
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/indirect.xs?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/indirect.xs (original)
+++ trunk/libindirect-perl/indirect.xs Mon Oct 4 15:08:32 2010
@@ -62,6 +62,9 @@
#define I_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))
#if I_HAS_PERL(5, 10, 0) || defined(PL_parser)
+# ifndef PL_linestr
+# define PL_linestr PL_parser->linestr
+# endif
# ifndef PL_bufptr
# define PL_bufptr PL_parser->bufptr
# endif
@@ -69,6 +72,9 @@
# define PL_oldbufptr PL_parser->oldbufptr
# endif
#else
+# ifndef PL_linestr
+# define PL_linestr PL_Ilinestr
+# endif
# ifndef PL_bufptr
# define PL_bufptr PL_Ibufptr
# endif
@@ -78,7 +84,7 @@
#endif
#ifndef I_WORKAROUND_REQUIRE_PROPAGATION
-# define I_WORKAROUND_REQUIRE_PROPAGATION !I_HAS_PERL(5, 10, 1)
+# define I_WORKAROUND_REQUIRE_PROPAGATION !I_HAS_PERL(5, 12, 0)
#endif
/* ... Thread safety and multiplicity ...................................... */
@@ -176,10 +182,11 @@
* thread cleanup. */
typedef struct {
- const char *pos;
- char *buf;
- STRLEN len, size;
- line_t line;
+ STRLEN pos;
+ STRLEN size;
+ STRLEN len;
+ char *buf;
+ line_t line;
} indirect_op_info_t;
#define PTABLE_NAME ptable
@@ -377,33 +384,22 @@
STATIC SV *indirect_hint(pTHX) {
#define indirect_hint() indirect_hint(aTHX)
- SV *hint;
+ SV **val;
if (IN_PERL_RUNTIME)
return NULL;
-#if I_HAS_PERL(5, 9, 5)
- hint = Perl_refcounted_he_fetch(aTHX_ PL_curcop->cop_hints_hash,
- NULL,
- __PACKAGE__, __PACKAGE_LEN__,
- 0,
- indirect_hash);
-#else
- {
- SV **val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__,
- indirect_hash);
- if (!val)
- return 0;
- hint = *val;
- }
-#endif
- return indirect_detag(hint);
+ val = hv_fetch(GvHV(PL_hintgv), __PACKAGE__, __PACKAGE_LEN__, indirect_hash);
+ if (!val)
+ return NULL;
+
+ return indirect_detag(*val);
}
/* ... op -> source position ............................................... */
-STATIC void indirect_map_store(pTHX_ const OP *o, const char *src, SV *sv, line_t line) {
-#define indirect_map_store(O, S, N, L) indirect_map_store(aTHX_ (O), (S), (N), (L))
+STATIC void indirect_map_store(pTHX_ const OP *o, STRLEN pos, SV *sv, line_t line) {
+#define indirect_map_store(O, P, N, L) indirect_map_store(aTHX_ (O), (P), (N), (L))
indirect_op_info_t *oi;
const char *s;
STRLEN len;
@@ -431,7 +427,7 @@
Copy(s, oi->buf, len, char);
oi->len = len;
- oi->pos = src;
+ oi->pos = pos;
oi->line = line;
}
@@ -451,28 +447,35 @@
/* --- Check functions ----------------------------------------------------- */
-STATIC const char *indirect_find(pTHX_ SV *sv, const char *s) {
-#define indirect_find(N, S) indirect_find(aTHX_ (N), (S))
+STATIC int indirect_find(pTHX_ SV *sv, const char *s, STRLEN *pos) {
+#define indirect_find(N, S, P) indirect_find(aTHX_ (N), (S), (P))
STRLEN len;
- const char *p = NULL, *r = SvPV_const(sv, len);
+ const char *p, *r = SvPV_const(sv, len);
if (len >= 1 && *r == '$') {
++r;
--len;
s = strchr(s, '$');
if (!s)
- return NULL;
- }
-
- p = strstr(s, r);
- while (p) {
- p += len;
- if (!isALNUM(*p))
+ return 0;
+ }
+
+ p = s;
+ while (1) {
+ p = strstr(p, r);
+ if (!p)
+ return 0;
+ if (!isALNUM(p[len]))
break;
- p = strstr(p + 1, r);
- }
-
- return p;
+ /* p points to a word that has r as prefix, skip the rest of the word */
+ p += len + 1;
+ while (isALNUM(*p))
+ ++p;
+ }
+
+ *pos = p - SvPVX_const(PL_linestr);
+
+ return 1;
}
/* ... ck_const ............................................................ */
@@ -480,14 +483,18 @@
STATIC OP *(*indirect_old_ck_const)(pTHX_ OP *) = 0;
STATIC OP *indirect_ck_const(pTHX_ OP *o) {
- o = CALL_FPTR(indirect_old_ck_const)(aTHX_ o);
+ o = indirect_old_ck_const(aTHX_ o);
if (indirect_hint()) {
SV *sv = cSVOPo_sv;
+
if (SvPOK(sv) && (SvTYPE(sv) >= SVt_PV)) {
- const char *s = indirect_find(sv, PL_oldbufptr);
- indirect_map_store(o, s, sv, CopLINE(&PL_compiling));
- return o;
+ STRLEN pos;
+
+ if (indirect_find(sv, PL_oldbufptr, &pos)) {
+ indirect_map_store(o, pos, sv, CopLINE(&PL_compiling));
+ return o;
+ }
}
}
@@ -503,8 +510,8 @@
if (indirect_hint()) {
OP *op = cUNOPo->op_first;
SV *sv;
- const char *name = NULL, *s;
- STRLEN len;
+ const char *name = NULL;
+ STRLEN pos, len;
OPCODE type = (OPCODE) op->op_type;
switch (type) {
@@ -527,8 +534,8 @@
sv = sv_2mortal(newSVpvn("$", 1));
sv_catpvn_nomg(sv, name, len);
- s = indirect_find(sv, PL_oldbufptr);
- if (!s) { /* If it failed, retry without the current stash */
+ if (!indirect_find(sv, PL_oldbufptr, &pos)) {
+ /* If it failed, retry without the current stash */
const char *stash = HvNAME_get(PL_curstash);
STRLEN stashlen = HvNAMELEN_get(PL_curstash);
@@ -545,18 +552,18 @@
sv_setpvn(sv, "$", 1);
stashlen += 2;
sv_catpvn_nomg(sv, name + stashlen, len - stashlen);
- s = indirect_find(sv, PL_oldbufptr);
- if (!s)
+ if (!indirect_find(sv, PL_oldbufptr, &pos))
goto done;
}
- o = CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o);
- indirect_map_store(o, s, sv, CopLINE(&PL_compiling));
+ o = indirect_old_ck_rv2sv(aTHX_ o);
+
+ indirect_map_store(o, pos, sv, CopLINE(&PL_compiling));
return o;
}
done:
- o = CALL_FPTR(indirect_old_ck_rv2sv)(aTHX_ o);
+ o = indirect_old_ck_rv2sv(aTHX_ o);
indirect_map_delete(o);
return o;
@@ -567,7 +574,7 @@
STATIC OP *(*indirect_old_ck_padany)(pTHX_ OP *) = 0;
STATIC OP *indirect_ck_padany(pTHX_ OP *o) {
- o = CALL_FPTR(indirect_old_ck_padany)(aTHX_ o);
+ o = indirect_old_ck_padany(aTHX_ o);
if (indirect_hint()) {
SV *sv;
@@ -579,7 +586,8 @@
while (s < t && isSPACE(*t)) --t;
sv = sv_2mortal(newSVpvn("$", 1));
sv_catpvn_nomg(sv, s, t - s + 1);
- indirect_map_store(o, s, sv, CopLINE(&PL_compiling));
+ indirect_map_store(o, s - SvPVX_const(PL_linestr),
+ sv, CopLINE(&PL_compiling));
return o;
}
}
@@ -600,10 +608,11 @@
case OP_SCOPE: old_ck = indirect_old_ck_scope; break;
case OP_LINESEQ: old_ck = indirect_old_ck_lineseq; break;
}
- o = CALL_FPTR(old_ck)(aTHX_ o);
+ o = old_ck(aTHX_ o);
if (indirect_hint()) {
- indirect_map_store(o, PL_oldbufptr, NULL, CopLINE(&PL_compiling));
+ indirect_map_store(o, PL_oldbufptr - SvPVX_const(PL_linestr),
+ NULL, CopLINE(&PL_compiling));
return o;
}
@@ -626,57 +635,77 @@
* don't trip up on $obj->$meth. */
if (op && op->op_type == OP_CONST) {
const indirect_op_info_t *oi = indirect_map_fetch(op);
- const char *s = NULL;
+ STRLEN pos;
line_t line;
SV *sv;
- if (oi && (s = oi->pos)) {
- sv = sv_2mortal(newSVpvn(oi->buf, oi->len));
- /* Keep the old line so that we really point to the first line of the
- * expression. */
- line = oi->line;
- } else {
- sv = cSVOPx_sv(op);
- if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV))
- goto done;
- sv = sv_mortalcopy(sv);
- s = indirect_find(sv, PL_oldbufptr);
- line = CopLINE(&PL_compiling);
- }
-
- o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
+ if (!oi)
+ goto done;
+
+ sv = sv_2mortal(newSVpvn(oi->buf, oi->len));
+ pos = oi->pos;
+ /* Keep the old line so that we really point to the first line of the
+ * expression. */
+ line = oi->line;
+
+ o = indirect_old_ck_method(aTHX_ o);
/* o may now be a method_named */
- indirect_map_store(o, s, sv, line);
+ indirect_map_store(o, pos, sv, line);
return o;
}
}
done:
- o = CALL_FPTR(indirect_old_ck_method)(aTHX_ o);
+ o = indirect_old_ck_method(aTHX_ o);
indirect_map_delete(o);
return o;
}
+/* ... ck_method_named ..................................................... */
+
+/* "use foo/no foo" compiles its call to import/unimport directly to a
+ * method_named op. */
+
+STATIC OP *(*indirect_old_ck_method_named)(pTHX_ OP *) = 0;
+
+STATIC OP *indirect_ck_method_named(pTHX_ OP *o) {
+ if (indirect_hint()) {
+ STRLEN pos;
+ line_t line;
+ SV *sv;
+
+ sv = cSVOPo_sv;
+ if (!SvPOK(sv) || (SvTYPE(sv) < SVt_PV))
+ goto done;
+ sv = sv_mortalcopy(sv);
+
+ if (!indirect_find(sv, PL_oldbufptr, &pos))
+ goto done;
+ line = CopLINE(&PL_compiling);
+
+ o = indirect_old_ck_method_named(aTHX_ o);
+
+ indirect_map_store(o, pos, sv, line);
+ return o;
+ }
+
+done:
+ o = indirect_old_ck_method_named(aTHX_ o);
+
+ indirect_map_delete(o);
+ return o;
+}
+
/* ... ck_entersub ......................................................... */
-
-STATIC int indirect_is_indirect(const indirect_op_info_t *moi, const indirect_op_info_t *ooi) {
- if (moi->pos > ooi->pos)
- return 0;
-
- if (moi->pos == ooi->pos)
- return moi->len == ooi->len && !memcmp(moi->buf, ooi->buf, moi->len);
-
- return 1;
-}
STATIC OP *(*indirect_old_ck_entersub)(pTHX_ OP *) = 0;
STATIC OP *indirect_ck_entersub(pTHX_ OP *o) {
SV *code = indirect_hint();
- o = CALL_FPTR(indirect_old_ck_entersub)(aTHX_ o);
+ o = indirect_old_ck_entersub(aTHX_ o);
if (code) {
const indirect_op_info_t *moi, *ooi;
@@ -713,14 +742,17 @@
goto done;
moi = indirect_map_fetch(mop);
- if (!(moi && moi->pos))
+ if (!moi)
goto done;
ooi = indirect_map_fetch(oop);
- if (!(ooi && ooi->pos))
+ if (!ooi)
goto done;
- if (indirect_is_indirect(moi, ooi)) {
+ /* When positions are identical, the method and the object must have the
+ * same name. But it also means that it is an indirect call, as "foo->foo"
+ * results in different positions. */
+ if (moi->pos <= ooi->pos) {
SV *file;
dSP;
@@ -772,21 +804,23 @@
ptable_hints_free(MY_CXT.tbl);
#endif
- PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_old_ck_const);
- indirect_old_ck_const = 0;
- PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_old_ck_rv2sv);
- indirect_old_ck_rv2sv = 0;
- PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_old_ck_padany);
- indirect_old_ck_padany = 0;
- PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_old_ck_scope);
- indirect_old_ck_scope = 0;
- PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_old_ck_lineseq);
- indirect_old_ck_lineseq = 0;
-
- PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_old_ck_method);
- indirect_old_ck_method = 0;
- PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_old_ck_entersub);
- indirect_old_ck_entersub = 0;
+ PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_old_ck_const);
+ indirect_old_ck_const = 0;
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_old_ck_rv2sv);
+ indirect_old_ck_rv2sv = 0;
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_old_ck_padany);
+ indirect_old_ck_padany = 0;
+ PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_old_ck_scope);
+ indirect_old_ck_scope = 0;
+ PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_old_ck_lineseq);
+ indirect_old_ck_lineseq = 0;
+
+ PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_old_ck_method);
+ indirect_old_ck_method = 0;
+ PL_check[OP_METHOD_NAMED] = MEMBER_TO_FPTR(indirect_old_ck_method_named);
+ indirect_old_ck_method_named = 0;
+ PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_old_ck_entersub);
+ indirect_old_ck_entersub = 0;
indirect_initialized = 0;
}
@@ -805,21 +839,23 @@
MY_CXT.map = ptable_new();
}
- indirect_old_ck_const = PL_check[OP_CONST];
- PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const);
- indirect_old_ck_rv2sv = PL_check[OP_RV2SV];
- PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_ck_rv2sv);
- indirect_old_ck_padany = PL_check[OP_PADANY];
- PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_ck_padany);
- indirect_old_ck_scope = PL_check[OP_SCOPE];
- PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_ck_scope);
- indirect_old_ck_lineseq = PL_check[OP_LINESEQ];
- PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_ck_scope);
-
- indirect_old_ck_method = PL_check[OP_METHOD];
- PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method);
- indirect_old_ck_entersub = PL_check[OP_ENTERSUB];
- PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_ck_entersub);
+ indirect_old_ck_const = PL_check[OP_CONST];
+ PL_check[OP_CONST] = MEMBER_TO_FPTR(indirect_ck_const);
+ indirect_old_ck_rv2sv = PL_check[OP_RV2SV];
+ PL_check[OP_RV2SV] = MEMBER_TO_FPTR(indirect_ck_rv2sv);
+ indirect_old_ck_padany = PL_check[OP_PADANY];
+ PL_check[OP_PADANY] = MEMBER_TO_FPTR(indirect_ck_padany);
+ indirect_old_ck_scope = PL_check[OP_SCOPE];
+ PL_check[OP_SCOPE] = MEMBER_TO_FPTR(indirect_ck_scope);
+ indirect_old_ck_lineseq = PL_check[OP_LINESEQ];
+ PL_check[OP_LINESEQ] = MEMBER_TO_FPTR(indirect_ck_scope);
+
+ indirect_old_ck_method = PL_check[OP_METHOD];
+ PL_check[OP_METHOD] = MEMBER_TO_FPTR(indirect_ck_method);
+ indirect_old_ck_method_named = PL_check[OP_METHOD_NAMED];
+ PL_check[OP_METHOD_NAMED] = MEMBER_TO_FPTR(indirect_ck_method_named);
+ indirect_old_ck_entersub = PL_check[OP_ENTERSUB];
+ PL_check[OP_ENTERSUB] = MEMBER_TO_FPTR(indirect_ck_entersub);
#if I_MULTIPLICITY
call_atexit(indirect_teardown, aTHX);
Modified: trunk/libindirect-perl/lib/indirect.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/lib/indirect.pm?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/lib/indirect.pm (original)
+++ trunk/libindirect-perl/lib/indirect.pm Mon Oct 4 15:08:32 2010
@@ -11,13 +11,13 @@
=head1 VERSION
-Version 0.22
+Version 0.23
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.22';
+ $VERSION = '0.23';
}
=head1 SYNOPSIS
@@ -181,7 +181,8 @@
The implementation was tweaked to work around several limitations of vanilla C<perl> pragmas : it's thread safe, and does not suffer from a C<perl 5.8.x-5.10.0> bug that causes all pragmas to propagate into C<require>d scopes.
-C<meth $obj> (no semicolon) at the end of a file won't be seen as an indirect object syntax, although it will as soon as there is another token before the end (as in C<meth $obj;> or C<meth $obj 1>).
+Before C<perl> 5.12, C<meth $obj> (no semicolon) at the end of a file is not seen as an indirect object syntax, although it is as soon as there is another token before the end (as in C<meth $obj;> or C<meth $obj 1>).
+If you use C<perl> 5.12 or greater, those constructs are correctly reported.
With 5.8 perls, the pragma does not propagate into C<eval STRING>.
This is due to a shortcoming in the way perl handles the hints hash, which is addressed in perl 5.10.
Modified: trunk/libindirect-perl/t/40-threads.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libindirect-perl/t/40-threads.t?rev=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/t/40-threads.t (original)
+++ trunk/libindirect-perl/t/40-threads.t Mon Oct 4 15:08:32 2010
@@ -3,14 +3,20 @@
use strict;
use warnings;
+sub skipall {
+ my ($msg) = @_;
+ require Test::More;
+ Test::More::plan(skip_all => $msg);
+}
+
use Config qw/%Config/;
BEGIN {
- if (!$Config{useithreads}) {
- require Test::More;
- Test::More->import;
- plan(skip_all => 'This perl wasn\'t built to support threads');
- }
+ my $force = $ENV{PERL_INDIRECT_TEST_THREADS} ? 1 : !1;
+ skipall 'This perl wasn\'t built to support threads'
+ unless $Config{useithreads};
+ skipall 'perl 5.13.4 required to test thread safety'
+ unless $force or $] >= 5.013004;
}
use threads;
@@ -20,12 +26,9 @@
BEGIN {
delete $ENV{PERL_INDIRECT_PM_DISABLE};
require indirect;
- if (indirect::I_THREADSAFE()) {
- plan tests => 10 * 2 * (2 + 3);
- defined and diag "Using threads $_" for $threads::VERSION;
- } else {
- plan skip_all => 'This indirect isn\'t thread safe';
- }
+ skipall 'This indirect isn\'t thread safe' unless indirect::I_THREADSAFE();
+ plan tests => 10 * 2 * (2 + 3);
+ defined and diag "Using threads $_" for $threads::VERSION;
}
sub expect {
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=63313&op=diff
==============================================================================
--- trunk/libindirect-perl/t/41-threads-teardown.t (original)
+++ trunk/libindirect-perl/t/41-threads-teardown.t Mon Oct 4 15:08:32 2010
@@ -3,14 +3,20 @@
use strict;
use warnings;
+sub skipall {
+ my ($msg) = @_;
+ require Test::More;
+ Test::More::plan(skip_all => $msg);
+}
+
use Config qw/%Config/;
BEGIN {
- if (!$Config{useithreads}) {
- require Test::More;
- Test::More->import;
- plan(skip_all => 'This perl wasn\'t built to support threads');
- }
+ my $force = $ENV{PERL_INDIRECT_TEST_THREADS} ? 1 : !1;
+ skipall 'This perl wasn\'t built to support threads'
+ unless $Config{useithreads};
+ skipall 'perl 5.13.4 required to test thread safety'
+ unless $force or $] >= 5.013004;
}
use threads;
@@ -20,12 +26,9 @@
BEGIN {
delete $ENV{PERL_INDIRECT_PM_DISABLE};
require indirect;
- if (indirect::I_THREADSAFE()) {
- plan tests => 1;
- defined and diag "Using threads $_" for $threads::VERSION;
- } else {
- plan skip_all => 'This indirect isn\'t thread safe';
- }
+ skipall 'This indirect isn\'t thread safe' unless indirect::I_THREADSAFE();
+ plan tests => 1;
+ defined and diag "Using threads $_" for $threads::VERSION;
}
sub run_perl {
More information about the Pkg-perl-cvs-commits
mailing list