Change 33926: Integrate:

Change 33926 by nicholas@mouse-mill on 2008/05/25 21:12:26

	Integrate:
	[ 33732]
	Integrate:
	[ 33668]
	Subject: [PATCH] Double magic with '\&$x'
	From: "Vincent Pit" <perl@profvince.com>
	Date: Tue, 1 Apr 2008 10:48:17 +0200 (CEST)
	Message-ID: <34395.147.210.17.175.1207039697.squirrel@147.210.17.175>
	
	[ 33669]
	Fix C portability nit found by Jerry D. Hedden.
	
	[ 33685]
	Revert change #26334, which was introducing too many bugs
	
	[ 33686]
	Add a regression test for bug #52658 (fixed by change #33685)
	based on code by Wolf-Dietrich Moeller
	
	[ 33802]
	Integrate:
	[ 33665]
	Subject: [PATCH] is_gv_magical correctly check "ISA"
	From: Gerard Goossen <gerard@tty.nl>
	Date: Wed, 9 Apr 2008 12:12:44 +0200
	Message-ID: <20080409101244.GA11209@ostwald>
	
	[ 33741]
	Inline the trivial S_raise_signal function in the perl signal handler.
	
	This makes the code more readable and avoids the need for excuses
	for why the function is (still) named this way.
	
	It also effectively avoids segfaults observed with gcc-3.3 when
	the sibling-call optimization is used for invoking S_raise_signal()
	just before the signal handler returns.
	
	[ 33762]
	Cast the result of fpsetmask(0) to (void), as some implementations
	expand it via a macro, with a comma expression to calculate the return
	value, at which point gcc has the gall to warn that an expression
	calcualted is not used.
	Blame SCO for having to have fpsetmask(0) in the code to start with.
	
	[ 33763]
	Subject: [PATCH] Win32 process ids can have more than 16 bits
	From: "Jan Dubois" <jand@activestate.com>
	Date: Tue, 29 Apr 2008 01:14:39 -0700
	Message-ID: <01be01c8a9d1$12b32b10$38198130$@com>
	
	[ 33788]
	Record-style reads in Perl_sv_gets have to be done with read(), not
	fread() on VMS, and have been for some time.  Except that ain't gonna
	work with PerlIO::Scalar's in-memory files.  Old bug exposed by new 
	test in #33769.
	
	[ 33889]
	Integrate:
	[ 33778]
	Subject: Re: [perl #51636] segmentation fault with array ties
	From: "Vincent Pit" <perl@profvince.com>
	Date: Wed, 12 Mar 2008 17:37:40 +0100 (CET)
	Message-ID: <56287.147.210.17.175.1205339860.squirrel@147.210.17.175>

Affected files ...

... //depot/maint-5.8/perl/gv.c#116 integrate
... //depot/maint-5.8/perl/mg.c#164 integrate
... //depot/maint-5.8/perl/perl.h#184 integrate
... //depot/maint-5.8/perl/pp_ctl.c#189 integrate
... //depot/maint-5.8/perl/pp_hot.c#146 integrate
... //depot/maint-5.8/perl/sv.c#384 integrate
... //depot/maint-5.8/perl/t/op/pat.t#53 integrate
... //depot/maint-5.8/perl/win32/win32.c#53 integrate

Differences ...

==== //depot/maint-5.8/perl/gv.c#116 (text) ====
Index: perl/gv.c
--- perl/gv.c#115~33449~	2008-03-06 06:14:52.000000000 -0800
+++ perl/gv.c	2008-05-25 14:12:26.000000000 -0700
@@ -2067,7 +2067,7 @@
 	const char * const name1 = name + 1;
 	switch (*name) {
 	case 'I':
-	    if (len == 3 && name1[1] == 'S' && name[2] == 'A')
+	    if (len == 3 && name[1] == 'S' && name[2] == 'A')
 		goto yes;
 	    break;
 	case 'O':

==== //depot/maint-5.8/perl/mg.c#164 (text) ====
Index: perl/mg.c
--- perl/mg.c#163~33454~	2008-03-08 15:09:00.000000000 -0800
+++ perl/mg.c	2008-05-25 14:12:26.000000000 -0700
@@ -1319,34 +1319,6 @@
     return 0;
 }
 
-/*
- * The signal handling nomenclature has gotten a bit confusing since the advent of
- * safe signals.  S_raise_signal only raises signals by analogy with what the 
- * underlying system's signal mechanism does.  It might be more proper to say that
- * it defers signals that have already been raised and caught.  
- *
- * PL_sig_pending and PL_psig_pend likewise do not track signals that are pending 
- * in the sense of being on the system's signal queue in between raising and delivery.  
- * They are only pending on Perl's deferral list, i.e., they track deferred signals 
- * awaiting delivery after the current Perl opcode completes and say nothing about
- * signals raised but not yet caught in the underlying signal implementation.
- */
-
-#ifndef SIG_PENDING_DIE_COUNT
-#  define SIG_PENDING_DIE_COUNT 120
-#endif
-
-static void
-S_raise_signal(pTHX_ int sig)
-{
-    /* Set a flag to say this signal is pending */
-    PL_psig_pend[sig]++;
-    /* And one to say _a_ signal is pending */
-    if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
-	Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
-		(unsigned long)SIG_PENDING_DIE_COUNT);
-}
-
 Signal_t
 Perl_csighandler(int sig)
 {
@@ -1367,7 +1339,7 @@
             exit(1);
 #endif
 #endif
-   if (
+    if (
 #ifdef SIGILL
 	   sig == SIGILL ||
 #endif
@@ -1381,8 +1353,19 @@
 	/* Call the perl level handler now--
 	 * with risk we may be in malloc() etc. */
 	(*PL_sighandlerp)(sig);
-   else
-	S_raise_signal(aTHX_ sig);
+    else {
+	/* Set a flag to say this signal is pending, that is awaiting delivery after
+	 * the current Perl opcode completes */
+	PL_psig_pend[sig]++;
+
+#ifndef SIG_PENDING_DIE_COUNT
+#  define SIG_PENDING_DIE_COUNT 120
+#endif
+	/* And one to say _a_ signal is pending */
+	if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT)
+	    Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded",
+		       (unsigned long)SIG_PENDING_DIE_COUNT);
+    }
 }
 
 #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS)

==== //depot/maint-5.8/perl/perl.h#184 (text) ====
Index: perl/perl.h
--- perl/perl.h#183~33866~	2008-05-19 07:57:58.000000000 -0700
+++ perl/perl.h	2008-05-25 14:12:26.000000000 -0700
@@ -2510,7 +2510,11 @@
 #    if HAS_FLOATINGPOINT_H
 #      include <floatingpoint.h>
 #    endif
-#    define PERL_FPU_INIT fpsetmask(0)
+/* Some operating systems have this as a macro, which in turn expands to a comma
+   expression, and the last sub-expression is something that gets calculated,
+   and then they have the gall to warn that a value computed is not used. Hence
+   cast to void.  */
+#    define PERL_FPU_INIT (void)fpsetmask(0)
 #  else
 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
 #      define PERL_FPU_INIT       PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN)

==== //depot/maint-5.8/perl/pp_ctl.c#189 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#188~33600~	2008-03-29 09:07:55.000000000 -0700
+++ perl/pp_ctl.c	2008-05-25 14:12:26.000000000 -0700
@@ -182,7 +182,6 @@
 	if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
 	    cx->sb_rxtainted |= 2;
 	sv_catsv(dstr, POPs);
-	FREETMPS; /* Prevent excess tmp stack */
 
 	/* Are we done */
 	if (CxONCE(cx) || !CALLREGEXEC(aTHX_ rx, s, cx->sb_strend, orig,

==== //depot/maint-5.8/perl/pp_hot.c#146 (text) ====
Index: perl/pp_hot.c
--- perl/pp_hot.c#145~33217~	2008-02-02 14:47:50.000000000 -0800
+++ perl/pp_hot.c	2008-05-25 14:12:26.000000000 -0700
@@ -1040,8 +1040,14 @@
 		*(relem++) = sv;
 		didstore = av_store(ary,i++,sv);
 		if (magic) {
-		    if (SvSMAGICAL(sv))
+		    if (SvSMAGICAL(sv)) {
+			/* More magic can happen in the mg_set callback, so we
+			 * backup the delaymagic for now. */
+			U16 dmbak = PL_delaymagic;
+			PL_delaymagic = 0;
 			mg_set(sv);
+			PL_delaymagic = dmbak;
+		    }
 		    if (!didstore)
 			sv_2mortal(sv);
 		}
@@ -1069,8 +1075,12 @@
 			duplicates += 2;
 		    didstore = hv_store_ent(hash,sv,tmpstr,0);
 		    if (magic) {
-			if (SvSMAGICAL(tmpstr))
+			if (SvSMAGICAL(tmpstr)) {
+			    U16 dmbak = PL_delaymagic;
+			    PL_delaymagic = 0;
 			    mg_set(tmpstr);
+			    PL_delaymagic = dmbak;
+			}
 			if (!didstore)
 			    sv_2mortal(tmpstr);
 		    }
@@ -1094,7 +1104,13 @@
 	    }
 	    else
 		sv_setsv(sv, &PL_sv_undef);
-	    SvSETMAGIC(sv);
+
+	    if (SvSMAGICAL(sv)) {
+		U16 dmbak = PL_delaymagic;
+		PL_delaymagic = 0;
+		mg_set(sv);
+		PL_delaymagic = dmbak;
+	    }
 	    break;
 	}
     }

==== //depot/maint-5.8/perl/sv.c#384 (text) ====
Index: perl/sv.c
--- perl/sv.c#383~33813~	2008-05-10 09:43:45.000000000 -0700
+++ perl/sv.c	2008-05-25 14:12:26.000000000 -0700
@@ -5789,6 +5789,9 @@
       I32 bytesread;
       char *buffer;
       U32 recsize;
+#ifdef VMS
+      int fd;
+#endif
 
       /* Grab the size of the record we're getting */
       recsize = SvUV(SvRV(PL_rs)); /* RsRECORD() guarantees > 0. */
@@ -5800,7 +5803,13 @@
       /* doing, but we've got no other real choice - except avoid stdio
          as implementation - perhaps write a :vms layer ?
        */
-      bytesread = PerlLIO_read(PerlIO_fileno(fp), buffer, recsize);
+      fd = PerlIO_fileno(fp);
+      if (fd == -1) { /* in-memory file from PerlIO::Scalar */
+          bytesread = PerlIO_read(fp, buffer, recsize);
+      }
+      else {
+          bytesread = PerlLIO_read(fd, buffer, recsize);
+      }
 #else
       bytesread = PerlIO_read(fp, buffer, recsize);
 #endif
@@ -6942,9 +6951,9 @@
 	goto fix_gv;
 
     default:
-	SvGETMAGIC(sv);
 	if (SvROK(sv)) {
 	    SV * const *sp = &sv;	/* Used in tryAMAGICunDEREF macro. */
+	    SvGETMAGIC(sv);
 	    tryAMAGICunDEREF(to_cv);
 
 	    sv = SvRV(sv);
@@ -6959,10 +6968,12 @@
 	    else
 		Perl_croak(aTHX_ "Not a subroutine reference");
 	}
-	else if (isGV(sv))
+	else if (isGV(sv)) {
+	    SvGETMAGIC(sv);
 	    gv = (GV*)sv;
+	}
 	else
-	    gv = gv_fetchsv(sv, lref, SVt_PVCV);
+	    gv = gv_fetchsv(sv, lref, SVt_PVCV); /* Calls get magic */
 	*gvp = gv;
 	if (!gv) {
 	    *st = NULL;

==== //depot/maint-5.8/perl/t/op/pat.t#53 (xtext) ====
Index: perl/t/op/pat.t
--- perl/t/op/pat.t#52~33923~	2008-05-25 13:30:46.000000000 -0700
+++ perl/t/op/pat.t	2008-05-25 14:12:26.000000000 -0700
@@ -3834,6 +3834,15 @@
     iseq($count,1,"Optimiser should have prevented more than one match");
 }
 
+# test for bug #52658
+{
+    my $reg = '../xxx/';
+    my @te = ($reg =~ m{^(/?(?:\.\./)*)}, $reg =~ s/(x)/'b'/eg > 1 ? '##' : '++');
+    #print "with bug:     (0)=$te[0]  (1)=$te[1]  reg=$reg\n";
+    iseq($reg, '../bbb/');
+    iseq($te[0], '../');
+}
+
 SKIP: {
     unless ($ordA == 65) { skip("Assumes ASCII", 4) }
 
@@ -3861,7 +3870,6 @@
 	'IsPunct agrees with [:punct:] with explicit Latin1');
 } 
 
-
 # Test counter is at bottom of file. Put new tests above here.
 #-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
@@ -3877,4 +3885,4 @@
 
 # Put new tests above the dotted line about a page above this comment
 
-BEGIN{print "1..1274\n"};
+BEGIN{print "1..1276\n"};

==== //depot/maint-5.8/perl/win32/win32.c#53 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c#52~33593~	2008-03-28 12:45:31.000000000 -0700
+++ perl/win32/win32.c	2008-05-25 14:12:26.000000000 -0700
@@ -656,8 +656,7 @@
     }
 
     if (flag == P_NOWAIT) {
-	if (IsWin95())
-	    PL_statusvalue = -1;	/* >16bits hint for pp_system() */
+	PL_statusvalue = -1;	/* >16bits hint for pp_system() */
     }
     else {
 	if (status < 0) {
@@ -770,8 +769,7 @@
 	Safefree(argv);
     }
     if (exectype == EXECF_SPAWN_NOWAIT) {
-	if (IsWin95())
-	    PL_statusvalue = -1;	/* >16bits hint for pp_system() */
+	PL_statusvalue = -1;	/* >16bits hint for pp_system() */
     }
     else {
 	if (status < 0) {
End of Patch.

• Change 33926: Integrate: by Nicholas Clark