[perl #7508] Use NULL for nonexistent array elems

This commit fixes bug #7508 and provides the groundwork for fixing
several other bugs.

Elements of @_ are aliased to the arguments, so that \$_[0] within
sub foo will reference the same scalar as \$x if the sub is called
as foo($x).

&PL_sv_undef (the global read-only undef scalar returned by the
‘undef’ operator itself) was being used to represent nonexistent
array elements.  So the pattern would be broken for foo(undef), where
\$_[0] would vivify a new $_[0] element, treating it as having been
nonexistent.

This also causes other problems with constants under ithreads
(#105906) and causes a pending fix for another bug (#118691) to trig-
ger this bug.

This commit changes the internals to use a null pointer to represent a
nonexistent element.

This requires that Storable be changed to account for it.  Also,
IPC::Open3 was relying on the bug.  So this commit patches
both modules.

2 files changed, 56 insertions, 8 deletions

diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs
index 439009a789..c89517007e 100644
--- a/dist/Storable/Storable.xs
+++ b/dist/Storable/Storable.xs
@@ -156,7 +156,8 @@
 #define SX_WEAKOVERLOAD	C(28)	/* Overloaded weak reference */
 #define SX_VSTRING	C(29)	/* vstring forthcoming (small) */
 #define SX_LVSTRING	C(30)	/* vstring forthcoming (large) */
-#define SX_ERROR	C(31)	/* Error */
+#define SX_SVUNDEF_ELEM	C(31)	/* array element set to &PL_sv_undef */
+#define SX_ERROR	C(32)	/* Error */
 
 /*
  * Those are only used to retrieve "old" pre-0.6 binary images.
@@ -843,7 +844,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #endif
 
 #define STORABLE_BIN_MAJOR	2		/* Binary major "version" */
-#define STORABLE_BIN_MINOR	9		/* Binary minor "version" */
+#define STORABLE_BIN_MINOR	10		/* Binary minor "version" */
 
 #if (PATCHLEVEL <= 5)
 #define STORABLE_BIN_WRITE_MINOR	4
@@ -852,6 +853,9 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
  * Perl 5.6.0-5.8.0 can do weak references, but not vstring magic.
 */
 #define STORABLE_BIN_WRITE_MINOR	8
+#elif PATCHLEVEL >= 19
+/* Perl 5.19 takes away the special meaning of PL_sv_undef in arrays. */
+#define STORABLE_BIN_WRITE_MINOR	10
 #else
 #define STORABLE_BIN_WRITE_MINOR	9
 #endif /* (PATCHLEVEL <= 5) */
@@ -935,7 +939,9 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #define STORE_SCALAR(pv, len)	STORE_PV_LEN(pv, len, SX_SCALAR, SX_LSCALAR)
 
 /*
- * Store &PL_sv_undef in arrays without recursing through store().
+ * Store &PL_sv_undef in arrays without recursing through store().  We
+ * actually use this to represent nonexistent elements, for historical
+ * reasons.
  */
 #define STORE_SV_UNDEF() 					\
   STMT_START {							\
@@ -1186,6 +1192,7 @@ static const sv_retrieve_t sv_old_retrieve[] = {
 	(sv_retrieve_t)retrieve_other,	/* SX_WEAKOVERLOAD not supported */
 	(sv_retrieve_t)retrieve_other,	/* SX_VSTRING not supported */
 	(sv_retrieve_t)retrieve_other,	/* SX_LVSTRING not supported */
+	(sv_retrieve_t)retrieve_other,	/* SX_SVUNDEF_ELEM not supported */
 	(sv_retrieve_t)retrieve_other,	/* SX_ERROR */
 };
 
@@ -1206,6 +1213,7 @@ static SV *retrieve_weakref(pTHX_ stcxt_t *cxt, const char *cname);
 static SV *retrieve_weakoverloaded(pTHX_ stcxt_t *cxt, const char *cname);
 static SV *retrieve_vstring(pTHX_ stcxt_t *cxt, const char *cname);
 static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname);
+static SV *retrieve_svundef_elem(pTHX_ stcxt_t *cxt, const char *cname);
 
 static const sv_retrieve_t sv_retrieve[] = {
 	0,			/* SX_OBJECT -- entry unused dynamically */
@@ -1239,6 +1247,7 @@ static const sv_retrieve_t sv_retrieve[] = {
 	(sv_retrieve_t)retrieve_weakoverloaded,	/* SX_WEAKOVERLOAD */
 	(sv_retrieve_t)retrieve_vstring,	/* SX_VSTRING */
 	(sv_retrieve_t)retrieve_lvstring,	/* SX_LVSTRING */
+	(sv_retrieve_t)retrieve_svundef_elem,	/* SX_SVUNDEF_ELEM */
 	(sv_retrieve_t)retrieve_other,		/* SX_ERROR */
 };
 
@@ -2253,10 +2262,23 @@ static int store_array(pTHX_ stcxt_t *cxt, AV *av)
 	for (i = 0; i < len; i++) {
 		sav = av_fetch(av, i, 0);
 		if (!sav) {
-			TRACEME(("(#%d) undef item", i));
+			TRACEME(("(#%d) nonexistent item", i));
 			STORE_SV_UNDEF();
 			continue;
 		}
+#if PATCHLEVEL >= 19
+		/* In 5.19.3 and up, &PL_sv_undef can actually be stored in
+		 * an array; it no longer represents nonexistent elements.
+		 * Historically, we have used SX_SV_UNDEF in arrays for
+		 * nonexistent elements, so we use SX_SVUNDEF_ELEM for
+		 * &PL_sv_undef itself. */
+		if (*sav == &PL_sv_undef) {
+			TRACEME(("(#%d) undef item", i));
+			cxt->tagnum++;
+			PUTMARK(SX_SVUNDEF_ELEM);
+			continue;
+		}
+#endif			
 		TRACEME(("(#%d) item", i));
 		if ((ret = store(aTHX_ cxt, *sav)))	/* Extra () for -Wall, grr... */
 			return ret;
@@ -5238,6 +5260,24 @@ static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname)
 }
 
 /*
+ * retrieve_svundef_elem
+ *
+ * Return &PL_sv_placeholder, representing &PL_sv_undef in an array.  This
+ * is a bit of a hack, but we already use SX_SV_UNDEF to mean a nonexistent
+ * element, for historical reasons.
+ */
+static SV *retrieve_svundef_elem(pTHX_ stcxt_t *cxt, const char *cname)
+{
+	TRACEME(("retrieve_svundef_elem"));
+
+	/* SEEN reads the contents of its SV argument, which we are not
+	   supposed to do with &PL_sv_placeholder. */
+	SEEN(&PL_sv_undef, cname, 1);
+
+	return &PL_sv_placeholder;
+}
+
+/*
  * retrieve_array
  *
  * Retrieve a whole array.
@@ -5253,6 +5293,7 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
 	AV *av;
 	SV *sv;
 	HV *stash;
+	bool seen_null = FALSE;
 
 	TRACEME(("retrieve_array (#%d)", cxt->tagnum));
 
@@ -5279,9 +5320,16 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname)
 		sv = retrieve(aTHX_ cxt, 0);			/* Retrieve item */
 		if (!sv)
 			return (SV *) 0;
+		if (sv == &PL_sv_undef) {
+			seen_null = TRUE;
+			continue;
+		}
+		if (sv == &PL_sv_placeholder)
+			sv = &PL_sv_undef;
 		if (av_store(av, i, sv) == 0)
 			return (SV *) 0;
 	}
+	if (seen_null) av_fill(av, len-1);
 
 	TRACEME(("ok (retrieve_array at 0x%"UVxf")", PTR2UV(av)));
 
diff --git a/dist/Storable/t/malice.t b/dist/Storable/t/malice.t
index ffc9fcf54f..867a0d7505 100644
--- a/dist/Storable/t/malice.t
+++ b/dist/Storable/t/malice.t
@@ -34,8 +34,8 @@ $file_magic_str = 'pst0';
 $other_magic = 7 + length $byteorder;
 $network_magic = 2;
 $major = 2;
-$minor = 9;
-$minor_write = $] > 5.008 ? 9 : $] > 5.005_50 ? 8 : 4;
+$minor = 10;
+$minor_write = $] >= 5.019 ? 10 : $] > 5.008 ? 9 : $] > 5.005_50 ? 8 : 4;
 
 use Test::More;
 
@@ -208,7 +208,7 @@ sub test_things {
     $where = $file_magic + $network_magic;
   }
 
-  # Just the header and a tag 255. As 30 is currently the highest tag, this
+  # Just the header and a tag 255. As 31 is currently the highest tag, this
   # is "unexpected"
   $copy = substr ($contents, 0, $where) . chr 255;
 
@@ -228,7 +228,7 @@ sub test_things {
   # local $Storable::DEBUGME = 1;
   # This is the delayed croak
   test_corrupt ($copy, $sub,
-                "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 30/",
+                "/^Storable binary image v$header->{major}.$minor6 contains data of type 255. This Storable is v$header->{major}.$minor and can only handle data types up to 31/",
                 "bogus tag, minor plus 4");
   # And check again that this croak is not delayed:
   {