X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=412eb57c467adadb726690f4505f8ea4582a4216;hb=f2f2613b8fd93f228ac9506438022acbc86e641f;hp=94fbc159ba20ca01cd6096f4e95983c87e1ccff1;hpb=80252599d4b7fb26eec4e3a0f451b4387c5dcc19;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 94fbc15..412eb57 100644
--- a/op.c
+++ b/op.c
@@ -52,6 +52,7 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
 static OP *newDEFSVOP _((void));
 static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
 static void simplify_sort _((OP *o));
+static bool is_handle_constructor _((OP *o, I32 argnum));
 #endif
 
 STATIC char*
@@ -1387,6 +1388,28 @@ scalar_mod_type(OP *o, I32 type)
     }
 }
 
+STATIC bool
+is_handle_constructor(OP *o, I32 argnum)
+{
+    switch (o->op_type) {
+    case OP_PIPE_OP:
+    case OP_SOCKPAIR:
+	if (argnum == 2)
+	    return TRUE;
+	/* FALL THROUGH */
+    case OP_SYSOPEN:
+    case OP_OPEN:
+    case OP_SOCKET:
+    case OP_OPEN_DIR:
+    case OP_ACCEPT:
+	if (argnum == 1)
+	    return TRUE;
+	/* FALL THROUGH */
+    default:
+	return FALSE;
+    }
+}
+
 OP *
 refkids(OP *o, I32 type)
 {
@@ -1423,6 +1446,8 @@ ref(OP *o, I32 type)
 	    ref(kid, type);
 	break;
     case OP_RV2SV:
+	if (type == OP_DEFINED)
+	    o->op_flags |= OPf_SPECIAL;		/* don't create GV */
 	ref(cUNOPo->op_first, o->op_type);
 	/* FALL THROUGH */
     case OP_PADSV:
@@ -1443,6 +1468,8 @@ ref(OP *o, I32 type)
 	o->op_flags |= OPf_REF;
 	/* FALL THROUGH */
     case OP_RV2GV:
+	if (type == OP_DEFINED)
+	    o->op_flags |= OPf_SPECIAL;		/* don't create GV */
 	ref(cUNOPo->op_first, o->op_type);
 	break;
 
@@ -4642,6 +4669,12 @@ ck_fun(OP *o)
 	    sibl = kid->op_sibling;
 	    switch (oa & 7) {
 	    case OA_SCALAR:
+		/* list seen where single (scalar) arg expected? */
+		if (numargs == 1 && !(oa >> 4)
+		    && kid->op_type == OP_LIST && type != OP_SCALAR)
+		{
+		    return too_many_arguments(o,PL_op_desc[type]);
+		}
 		scalar(kid);
 		break;
 	    case OA_LIST:
@@ -4654,7 +4687,8 @@ ck_fun(OP *o)
 		break;
 	    case OA_AVREF:
 		if (kid->op_type == OP_CONST &&
-		  (kid->op_private & OPpCONST_BARE)) {
+		    (kid->op_private & OPpCONST_BARE))
+		{
 		    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
 		    OP *newop = newAVREF(newGVOP(OP_GV, 0,
 			gv_fetchpv(name, TRUE, SVt_PVAV) ));
@@ -4668,12 +4702,13 @@ ck_fun(OP *o)
 		    *tokid = kid;
 		}
 		else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
-		    bad_type(numargs, "array", PL_op_desc[o->op_type], kid);
+		    bad_type(numargs, "array", PL_op_desc[type], kid);
 		mod(kid, type);
 		break;
 	    case OA_HVREF:
 		if (kid->op_type == OP_CONST &&
-		  (kid->op_private & OPpCONST_BARE)) {
+		    (kid->op_private & OPpCONST_BARE))
+		{
 		    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
 		    OP *newop = newHVREF(newGVOP(OP_GV, 0,
 			gv_fetchpv(name, TRUE, SVt_PVHV) ));
@@ -4687,7 +4722,7 @@ ck_fun(OP *o)
 		    *tokid = kid;
 		}
 		else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
-		    bad_type(numargs, "hash", PL_op_desc[o->op_type], kid);
+		    bad_type(numargs, "hash", PL_op_desc[type], kid);
 		mod(kid, type);
 		break;
 	    case OA_CVREF:
@@ -4704,7 +4739,8 @@ ck_fun(OP *o)
 	    case OA_FILEREF:
 		if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
 		    if (kid->op_type == OP_CONST &&
-		      (kid->op_private & OPpCONST_BARE)) {
+			(kid->op_private & OPpCONST_BARE))
+		    {
 			OP *newop = newGVOP(OP_GV, 0,
 			    gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
 					SVt_PVIO) );
@@ -4716,8 +4752,12 @@ ck_fun(OP *o)
 			bad_type(numargs, "HANDLE", PL_op_desc[o->op_type], kid);
 		    }
 		    else {
+			I32 flags = OPf_SPECIAL;
+			/* is this op a FH constructor? */
+			if (is_handle_constructor(o,numargs))
+			    flags = 0;
 			kid->op_sibling = 0;
-			kid = newUNOP(OP_RV2GV, 0, scalar(kid));
+			kid = newUNOP(OP_RV2GV, flags, scalar(kid));
 		    }
 		    kid->op_sibling = sibl;
 		    *tokid = kid;