This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Change SAVECOPWARNINGS(c) to SAVECOMPILEWARNINGS() - it's only used to
authorNicholas Clark <nick@ccl4.org>
Fri, 14 Apr 2006 20:44:27 +0000 (20:44 +0000)
committerNicholas Clark <nick@ccl4.org>
Fri, 14 Apr 2006 20:44:27 +0000 (20:44 +0000)
save the warnings on PL_compiling, so constraining its use to what we
can test seems to make sense. Particularly as testing Perl_ss_dup is
tricky.

p4raw-id: //depot/perl@27805

op.c
pp_ctl.c
scope.c
scope.h
sv.c

diff --git a/op.c b/op.c
index 3bb789b..593485d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1983,7 +1983,7 @@ Perl_block_start(pTHX_ int full)
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVECOPWARNINGS(&PL_compiling);
+    SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
     SAVESPTR(PL_compiling.cop_io);
     if (! specialCopIO(PL_compiling.cop_io)) {
index 0307a2e..7beea6a 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3364,7 +3364,7 @@ PP(pp_require)
     PL_rsfp = tryrsfp;
     SAVEHINTS();
     PL_hints = 0;
-    SAVECOPWARNINGS(&PL_compiling);
+    SAVECOMPILEWARNINGS();
     if (PL_dowarn & G_WARN_ALL_ON)
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
@@ -3464,7 +3464,7 @@ PP(pp_entereval)
     PL_hints = PL_op->op_targ;
     if (saved_hh)
        GvHV(PL_hintgv) = saved_hh;
-    SAVECOPWARNINGS(&PL_compiling);
+    SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
     SAVESPTR(PL_compiling.cop_io);
     if (specialCopIO(PL_curcop->cop_io))
diff --git a/scope.c b/scope.c
index 94f648a..33763a7 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -984,16 +984,13 @@ Perl_leave_scope(pTHX_ I32 base)
            i = SSPOPINT;
            CopARYBASE_set((COP *)ptr, i);
            break;
-       case SAVEt_COP_WARNINGS:
-           {
-               COP *const cop = SSPOPPTR;
-               ptr = SSPOPPTR;
+       case SAVEt_COMPILE_WARNINGS:
+           ptr = SSPOPPTR;
 
-               if (!specialWARN(cop->cop_warnings))
-                   PerlMemShared_free(cop->cop_warnings);
+           if (!specialWARN(PL_compiling.cop_warnings))
+               PerlMemShared_free(PL_compiling.cop_warnings);
 
-               cop->cop_warnings = ptr;
-           }
+           PL_compiling.cop_warnings = ptr;
            break;
        case SAVEt_RE_STATE:
            {
diff --git a/scope.h b/scope.h
index 580d109..1506e5e 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -51,7 +51,7 @@
 #define SAVEt_SAVESWITCHSTACK  40
 #define SAVEt_COP_ARYBASE      41
 #define SAVEt_RE_STATE         42
-#define SAVEt_COP_WARNINGS     43
+#define SAVEt_COMPILE_WARNINGS 43
 
 #ifndef SCOPE_SAVES_SIGNAL_MASK
 #define SCOPE_SAVES_SIGNAL_MASK 0
@@ -198,12 +198,11 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
    could have done savefreesharedpvREF, but this way actually seems cleaner,
    as it simplifies the code that does the saves, and reduces the load on the
    save stack.  */
-#define SAVECOPWARNINGS(c) \
+#define SAVECOMPILEWARNINGS() \
     STMT_START {                                       \
-       SSCHECK(3);                                     \
-       SSPUSHPTR((c)->cop_warnings);                   \
-       SSPUSHPTR(c);                                   \
-       SSPUSHINT(SAVEt_COP_WARNINGS);                  \
+       SSCHECK(2);                                     \
+       SSPUSHPTR(PL_compiling.cop_warnings);           \
+       SSPUSHINT(SAVEt_COMPILE_WARNINGS);              \
     } STMT_END
 
 #ifdef USE_ITHREADS
diff --git a/sv.c b/sv.c
index a64b272..08d9b6a 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -10681,21 +10681,9 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
 #endif
                break;
            }
-       case SAVEt_COP_WARNINGS:
-           {
-               void *optr = POPPTR(ss,ix);
-               TOPPTR(nss,ix) = ptr = any_dup(optr, proto_perl);
-               if (ptr != optr) {
-                   /* We duped something in the interpreter structure.  */
-                   ptr = POPPTR(ss,ix);
-                   TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
-               } else {
-                   /* I don't think that this happens, but it would mean that
-                      we (didn't) dup something shared.  */
-                   ptr = POPPTR(ss,ix);
-                   TOPPTR(nss,ix) = ptr;
-               }
-           }
+       case SAVEt_COMPILE_WARNINGS:
+           ptr = POPPTR(ss,ix);
+           TOPPTR(nss,ix) = DUP_WARNINGS((STRLEN*)ptr);
            break;
        default:
            Perl_croak(aTHX_ "panic: ss_dup inconsistency (%"IVdf")", (IV) i);