Implement handling of state variables in list assignment

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index baed3fd..929f5a2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -245,7 +245,6 @@ PP(pp_substcont)
            if (DO_UTF8(dstr))
                SvUTF8_on(targ);
            SvPV_set(dstr, NULL);
-           sv_free(dstr);
 
            TAINT_IF(cx->sb_rxtainted & 1);
            PUSHs(sv_2mortal(newSViv(saviters - 1)));
@@ -1720,10 +1719,10 @@ PP(pp_caller)
         PUSHs(sv_2mortal(mask));
     }
 
-    PUSHs(cx->blk_oldcop->cop_hints ?
+    PUSHs(cx->blk_oldcop->cop_hints_hash ?
          sv_2mortal(newRV_noinc(
-               (SV*)Perl_refcounted_he_chain_2hv(aTHX_
-                                                 cx->blk_oldcop->cop_hints)))
+           (SV*)Perl_refcounted_he_chain_2hv(aTHX_
+                                             cx->blk_oldcop->cop_hints_hash)))
          : &PL_sv_undef);
     RETURN;
 }
@@ -3298,6 +3297,9 @@ PP(pp_require)
                            tryname += 2;
                        break;
                    }
+                   else if (errno == EMFILE)
+                       /* no point in trying other paths if out of handles */
+                       break;
                  }
                }
            }
@@ -3374,8 +3376,6 @@ PP(pp_require)
     }
     else
         PL_compiling.cop_warnings = pWARN_STD ;
-    SAVESPTR(PL_compiling.cop_io);
-    PL_compiling.cop_io = NULL;
 
     if (filter_sub || filter_cache) {
        SV * const datasv = filter_add(S_run_user_filter, NULL);
@@ -3469,20 +3469,13 @@ PP(pp_entereval)
        GvHV(PL_hintgv) = saved_hh;
     SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
-    SAVESPTR(PL_compiling.cop_io);
-    if (specialCopIO(PL_curcop->cop_io))
-        PL_compiling.cop_io = PL_curcop->cop_io;
-    else {
-        PL_compiling.cop_io = newSVsv(PL_curcop->cop_io);
-        SAVEFREESV(PL_compiling.cop_io);
-    }
-    if (PL_compiling.cop_hints) {
-       Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints);
+    if (PL_compiling.cop_hints_hash) {
+       Perl_refcounted_he_free(aTHX_ PL_compiling.cop_hints_hash);
     }
-    PL_compiling.cop_hints = PL_curcop->cop_hints;
-    if (PL_compiling.cop_hints) {
+    PL_compiling.cop_hints_hash = PL_curcop->cop_hints_hash;
+    if (PL_compiling.cop_hints_hash) {
        HINTS_REFCNT_LOCK;
-       PL_compiling.cop_hints->refcounted_he_refcnt++;
+       PL_compiling.cop_hints_hash->refcounted_he_refcnt++;
        HINTS_REFCNT_UNLOCK;
     }
     /* special case: an eval '' executed within the DB package gets lexically
@@ -3775,42 +3768,8 @@ PP(pp_smartmatch)
     return do_smartmatch(NULL, NULL);
 }
 
-/* This version of do_smartmatch() implements the following
-   table of smart matches:
-    
-    $a      $b        Type of Match Implied    Matching Code
-    ======  =====     =====================    =============
-    (overloading trumps everything)
-
-    Code[+] Code[+]   referential equality     match if refaddr($a) == refaddr($b)
-    Any     Code[+]   scalar sub truth         match if $b->($a)
-
-    Hash    Hash      hash keys identical      match if sort(keys(%$a)) ÈeqÇ sort(keys(%$b))
-    Hash    Array     hash value slice truth   match if $a->{any(@$b)}
-    Hash    Regex     hash key grep            match if any(keys(%$a)) =~ /$b/
-    Hash    Any       hash entry existence     match if exists $a->{$b}
-
-    Array   Array     arrays are identical[*]  match if $a È~~Ç $b
-    Array   Regex     array grep               match if any(@$a) =~ /$b/
-    Array   Num       array contains number    match if any($a) == $b
-    Array   Any       array contains string    match if any($a) eq $b
-
-    Any     undef     undefined                match if !defined $a
-    Any     Regex     pattern match            match if $a =~ /$b/
-    Code()  Code()    results are equal        match if $a->() eq $b->()
-    Any     Code()    simple closure truth     match if $b->() (ignoring $a)
-    Num     numish[!] numeric equality         match if $a == $b
-    Any     Str       string equality          match if $a eq $b
-    Any     Num       numeric equality         match if $a == $b
-
-    Any     Any       string equality          match if $a eq $b
-
-
- + - this must be a code reference whose prototype (if present) is not ""
-     (subs with a "" prototype are dealt with by the 'Code()' entry lower down)
- * - if a circular reference is found, we fall back to referential equality
- ! - either a real number, or a string that looks_like_number()
-
+/* This version of do_smartmatch() implements the
+ * table of smart matches that is found in perlsyn.
  */
 STATIC
 OP *