op.c: Apply spair optimisation to \% \@ \&

The ‘spair’ (scalar/single pair) optimisation applies to a few operat-
ors for which there are actually pairs of ops, one for scalars or sin-
gle items, the other for lists.  refgen is one of them.

When taking references, hashes, arrays and subroutines are single
items, just like scalars, so they can go through the ‘single’ code and
benefit, too.

refassign will also benefit from this, as \@A = [] (not yet imple-
mented) should provide scalar context to the right-hand side, and this
avoids the need for special cases (because srefgen with the initial s
provides scalar context).

(This optimisation could have applied to aggregates passed to cho(m)p,
but it results in incorrect messages like ‘Uninitialized value in sca-
lar chomp’ for chomp @_, so I’ve left it for now.)

op.c

@@ -1802,15 +1802,17 @@ Perl_scalarvoid(pTHX_ OP *o)
 
 	refgen = (UNOP *)((BINOP *)o)->op_first;
 
-	if (!refgen || refgen->op_type != OP_REFGEN)
+	if (!refgen || (refgen->op_type != OP_REFGEN
+			&& refgen->op_type != OP_SREFGEN))
 	    break;
 
 	exlist = (LISTOP *)refgen->op_first;
 	if (!exlist || exlist->op_type != OP_NULL
 	    || exlist->op_targ != OP_LIST)
 	    break;
 
-	if (exlist->op_first->op_type != OP_PUSHMARK)
+	if (exlist->op_first->op_type != OP_PUSHMARK
+	 && exlist->op_first != exlist->op_last)
 	    break;
 
 	rv2cv = (UNOP*)exlist->op_last;
@@ -8911,7 +8913,14 @@ Perl_ck_spair(pTHX_ OP *o)
 	newop = OP_SIBLING(kidkid);
 	if (newop) {
 	    const OPCODE type = newop->op_type;
-	    if (OP_HAS_SIBLING(newop) || !(PL_opargs[type] & OA_RETSCALAR))
+	    if (OP_HAS_SIBLING(newop))
+		return o;
+	    if (o->op_type == OP_REFGEN && !(newop->op_flags & OPf_PARENS)
+		&& (type == OP_RV2AV || type == OP_PADAV
+		 || type == OP_RV2HV || type == OP_PADHV
+		 || type == OP_RV2CV))
+	    	NOOP; /* OK (allow srefgen for \@a and \%h) */
+	    else if (!(PL_opargs[type] & OA_RETSCALAR))
 		return o;
 	}
         /* excise first sibling */
@@ -10627,7 +10636,8 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    case '&':
 		proto++;
 		arg++;
-		if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
+		if (o3->op_type != OP_REFGEN && o3->op_type != OP_SREFGEN
+		 && o3->op_type != OP_UNDEF)
 		    bad_type_gv(arg,
 			    arg == 1 ? "block or sub {}" : "sub {}",
 			    namegv, 0, o3);

t/lib/warnings/op

@@ -367,7 +367,7 @@ wantarray ; 		# OP_WANTARRAY
 			# OP_PADANY
 			# OP_AV2ARYLEN
 ref ;			# OP_REF
-\@a ;			# OP_REFGEN
+\(@a) ;			# OP_REFGEN
 \$a ;			# OP_SREFGEN
 defined $a ;		# OP_DEFINED
 hex $a ;		# OP_HEX