Integrate:

[ 21402]
Subject: [PATCH] pp_sys.c: pp_waitpid and EINTR
From: Steve Grazzini <grazz@pobox.com>
Date: Sat, 4 Oct 2003 18:15:23 -0400
Message-Id: <20031004221523.GA29324@grazzini.net>

[ 21425]
Fix bug #24108: Goto +foo broken
the fix having been suggested by xmath via Juerd.

[ 21428]
Subject: [PATCH] Devel::PPPort is missing an aTHX when calling
	 grok_numeric_radix()
From: Jan Dubois <jand@ActiveState.com>
Date: Wed, 08 Oct 2003 20:37:42 -0700
Message-Id: <8kl9ov0932qo08o24uafuc9v77clrgnoe4@4ax.com>

[ 21429]
Patch based on:

Subject: [perl #24157] -MModule=} is broken
From: "Lukas Mai" (via RT) <perlbug-followup@perl.org>
Date: 7 Oct 2003 21:47:43 -0000
Message-Id: <rt-24157-65809.10.9980909617566@rt.perl.org>

(Includes a fix for a similar problem in -A, but not -d.)

[ 21430]
Subject: [PATCH 5.8.1 CORE] Internal fixes to source-code coordinate
	 calculations in regcomp.c
From: Eric Promislow <ericp@ActiveState.com>
Date: Wed, 8 Oct 2003 17:42:42 -0700
Message-Id: <20031008174242.A17544@ActiveState.com>

[ 21441]
Subject: [PATCH] Internals::hash_seed() returns wrong value
From: Jan Dubois <jand@ActiveState.com>
Date: Sun, 12 Oct 2003 22:09:39 -0700
Message-ID: <07ckovck8mp5e8tthmtbbcrpi2tj6q9eak@4ax.com>

[ 21445]
Subject: [PATCH ext/Devel/PPPort/PPPort.pm] Changes #20819 and #20996 break compatibility with perl 5.6.0
From: "Marcus Holland-Moritz" <mhx-perl@gmx.net>
Date: Tue, 30 Sep 2003 19:23:34 +0200
Message-ID: <021e01c38777$93ea4e10$0c2f1fac@R2D2>
p4raw-link: @21445 on //depot/perl: 5a8cac993f5e531fd4379cb91dafffa00baacb2d
p4raw-link: @21441 on //depot/perl: 81eaca17788a9221a27310f8de41fa6679a5a1ee
p4raw-link: @21430 on //depot/perl: 459483364bd8ae7bd68c1206c3548757357dcc00
p4raw-link: @21429 on //depot/perl: 3d27e215577f06a0418206573270be9a039edb17
p4raw-link: @21428 on //depot/perl: b9f7248f5bf0348b2c36c1de17da1068f6300b55
p4raw-link: @21425 on //depot/perl: e3aba57ac4f86fb55aeef24f1f54bbd3531b9882
p4raw-link: @21402 on //depot/perl: 2ec0bfb3e2d19a14c6a2cf1939c9549394a191c1

p4raw-id: //depot/maint-5.8/perl@21490
p4raw-integrated: from //depot/perl@21489 'copy in' t/op/goto.t
	(@19625..) pp_sys.c (@21360..) 'merge in' universal.c
	(@21113..)
p4raw-integrated: from //depot/perl@21430 'merge in' regcomp.c
	(@21297..)
p4raw-edited: from //depot/perl@21429 'edit in' perl.c (@21186..)
p4raw-integrated: from //depot/perl@21428 'ignore'
	ext/Devel/PPPort/PPPort.pm (@21326..)
p4raw-integrated: from //depot/perl@21425 'merge in' op.c (@21406..)

diff --git a/ext/Devel/PPPort/PPPort.pm b/ext/Devel/PPPort/PPPort.pm
index d97832e..d9e6ccc 100644 (file)
--- a/ext/Devel/PPPort/PPPort.pm
+++ b/ext/Devel/PPPort/PPPort.pm
@@ -802,7 +802,7 @@ SV *sv;
 #   define PERL_SCAN_DISALLOW_PREFIX 0x02
 #endif
 
-#if (PERL_VERSION >= 6)
+#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
 #define I32_CAST
 #else
 #define I32_CAST (I32*)
@@ -877,7 +877,7 @@ static UV _grok_bin (char *string, STRLEN *len, I32 *flags, NV *result) {
 #endif
    
 #ifndef grok_numeric_radix
-#   define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+#   define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(aTHX_ sp, send)
 
 #define grok_numeric_radix Perl_grok_numeric_radix
     
@@ -885,7 +885,7 @@ bool
 Perl_grok_numeric_radix(pTHX_ const char **sp, const char *send)
 {
 #ifdef USE_LOCALE_NUMERIC
-#if (PERL_VERSION >= 6)
+#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
     if (PL_numeric_radix_sv && IN_LOCALE) { 
         STRLEN len;
         char* radix = SvPV(PL_numeric_radix_sv, len);

diff --git a/op.c b/op.c
index 50dfc9e..48e71b2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3873,7 +3873,9 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
        op_free(label);
     }
     else {
-       if (label->op_type == OP_ENTERSUB)
+       /* Check whether it's going to be a goto &function */
+       if (label->op_type == OP_ENTERSUB
+               && !(label->op_flags & OPf_STACKED))
            label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
        o = newUNOP(type, OPf_STACKED, label);
     }

diff --git a/perl.c b/perl.c
index 9e12d4e..54326c4 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2527,7 +2527,7 @@ Perl_moreswitches(pTHX_ char *s)
                sv_catpvn(sv, start, s-start);
                sv_catpv(sv, " split(/,/,q{");
                sv_catpv(sv, ++s);
-               sv_catpv(sv,    "})");
+               sv_catpv(sv, "})");
            }
            s += strlen(s);
            my_setenv("PERL5DB", SvPV(sv, PL_na));
@@ -2648,9 +2648,10 @@ Perl_moreswitches(pTHX_ char *s)
                     Perl_croak(aTHX_ "Module name required with -%c option",
                               s[-1]);
                sv_catpvn(sv, start, s-start);
-               sv_catpv(sv, " split(/,/,q{");
+               sv_catpv(sv, " split(/,/,q");
+               sv_catpvn(sv, "\0)", 1);        /* Use NUL as q//-delimiter. */
                sv_catpv(sv, ++s);
-               sv_catpv(sv,    "})");
+               sv_catpvn(sv,  "\0)", 2);
            }
            s += strlen(s);
            if (!PL_preambleav)

diff --git a/pp_sys.c b/pp_sys.c
index 8253df9..10d0529 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4037,27 +4037,28 @@ PP(pp_waitpid)
 {
 #if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL)
     dSP; dTARGET;
-    Pid_t childpid;
+    Pid_t pid;
+    Pid_t result;
     int optype;
     int argflags;
 
     optype = POPi;
-    childpid = TOPi;
+    pid = TOPi;
     if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
-        childpid = wait4pid(childpid, &argflags, optype);
+        result = wait4pid(pid, &argflags, optype);
     else {
-        while ((childpid = wait4pid(childpid, &argflags, optype)) == -1 &&
+        while ((result = wait4pid(pid, &argflags, optype)) == -1 &&
               errno == EINTR) {
          PERL_ASYNC_CHECK();
        }
     }
 #  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
     /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
-    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+    STATUS_NATIVE_SET((result && result != -1) ? argflags : -1);
 #  else
-    STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+    STATUS_NATIVE_SET((result > 0) ? argflags : -1);
 #  endif
-    SETi(childpid);
+    SETi(result);
     RETURN;
 #else
     DIE(aTHX_ PL_no_func, "waitpid");

diff --git a/regcomp.c b/regcomp.c
index bd900fb..e9ae5ab 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -2506,8 +2506,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
            if (paren == '>')
                node = SUSPEND, flag = 0;
            reginsert(pRExC_state, node,ret);
-           Set_Node_Offset(ret, oregcomp_parse);
-           Set_Node_Length(ret,  RExC_parse - oregcomp_parse + 2);
+           Set_Node_Cur_Length(ret);
+           Set_Node_Offset(ret, parse_start + 1);
            ret->flags = flag;
            regtail(pRExC_state, ret, reg_node(pRExC_state, TAIL));
        }
@@ -2788,7 +2788,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp)
 {
     register regnode *ret = 0;
     I32 flags;
-    char *parse_start = 0;
+    char *parse_start = RExC_parse;
 
     *flagp = WORST;            /* Tentatively. */
 
@@ -3051,6 +3051,7 @@ tryagain:
        default:
            /* Do not generate `unrecognized' warnings here, we fall
               back into the quick-grab loop below */
+           parse_start--;
            goto defchar;
        }
        break;
@@ -4420,6 +4421,7 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, U8 op, regnode *opnd)
               RExC_parse - RExC_start,
               RExC_offsets[0])); 
        Set_Node_Offset(place, RExC_parse);
+       Set_Node_Length(place, 1);
     }
     src = NEXTOPER(place);
     FILL_ADVANCE_NODE(place, op);

diff --git a/t/op/goto.t b/t/op/goto.t
index c156fd8..67d24c0 100755 (executable)
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -7,7 +7,7 @@ BEGIN {
     @INC = qw(. ../lib);
 }
 
-print "1..30\n";
+print "1..32\n";
 
 require "test.pl";
 
@@ -220,6 +220,14 @@ my $r = runperl(prog => 'use goto01; print qq[DONE\n]');
 is($r, "OK\nDONE\n", "goto within use-d file"); 
 unlink "goto01.pm";
 
+# test for [perl #24108]
+sub i_return_a_label {
+    print "ok 31 - i_return_a_label called\n";
+    return "returned_label";
+}
+eval { goto +i_return_a_label; };
+print "not ";
+returned_label : print "ok 32 - done to returned_label\n";
 
 exit;
 

diff --git a/universal.c b/universal.c
index ddda24f..ab3fd1c 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -723,6 +723,6 @@ XS(XS_Internals_hash_seed)
     /* Using dXSARGS would also have dITEM and dSP,
      * which define 2 unused local variables.  */
     dMARK; dAX;
-    XSRETURN_UV(PL_hash_seed);
+    XSRETURN_UV(PERL_HASH_SEED);
 }