slurping an empty file should return '' rather than undef, with
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 901995a..9e4f084 100644 (file)
--- a/op.c
+++ b/op.c
@@ -51,7 +51,8 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
        CV* startcv, I32 cx_ix, I32 saweval));
 static OP *newDEFSVOP _((void));
 static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
-static void simplify_sort(OP *o);
+static void simplify_sort _((OP *o));
+static bool is_handle_constructor _((OP *o, I32 argnum));
 #endif
 
 STATIC char*
@@ -1249,6 +1250,8 @@ mod(OP *o, I32 type)
     case OP_AV2ARYLEN:
        PL_hints |= HINT_BLOCK_SCOPE;
     case OP_SASSIGN:
+    case OP_ANDASSIGN:
+    case OP_ORASSIGN:
     case OP_AELEMFAST:
        PL_modcount++;
        break;
@@ -1379,14 +1382,36 @@ scalar_mod_type(OP *o, I32 type)
     case OP_READ:
     case OP_SYSREAD:
     case OP_RECV:
-    case OP_ANDASSIGN: /* may work later */
-    case OP_ORASSIGN:  /* may work later */
+    case OP_ANDASSIGN:
+    case OP_ORASSIGN:
        return TRUE;
     default:
        return FALSE;
     }
 }
 
+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 +1448,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 +1470,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 +4671,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 +4689,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 +4704,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 +4724,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 +4741,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 +4754,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;
@@ -4763,10 +4805,8 @@ ck_glob(OP *o)
        gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
     if (gv && GvIMPORTED_CV(gv)) {
-       static int glob_index;
-
        append_elem(OP_GLOB, o,
-                   newSVOP(OP_CONST, 0, newSViv(glob_index++)));
+                   newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
        o->op_type = OP_LIST;
        o->op_ppaddr = PL_ppaddr[OP_LIST];
        cLISTOPo->op_first->op_type = OP_PUSHMARK;
@@ -5050,7 +5090,7 @@ ck_sort(OP *o)
 #endif
 
     if (o->op_flags & OPf_STACKED)
-           simplify_sort(o);
+       simplify_sort(o);
     if (o->op_flags & OPf_STACKED) {                /* may have been cleared */
        OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
        OP *k;
@@ -5092,9 +5132,11 @@ ck_sort(OP *o)
 
     return o;
 }
-static void
+
+STATIC void
 simplify_sort(OP *o)
 {
+    dTHR;
     register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
     OP *k;
     int reversed;