This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Convert pad_check_dup() to static linkage, and call it from Perl_pad_add_name().
authorNicholas Clark <nick@ccl4.org>
Sat, 14 Nov 2009 20:18:39 +0000 (20:18 +0000)
committerNicholas Clark <nick@ccl4.org>
Sun, 15 Nov 2009 08:21:57 +0000 (08:21 +0000)
Provide a flag option to Perl_pad_add_name(), pad_add_NO_DUP_CHECK, to supress
the call.

embed.fnc
embed.h
op.c
pad.c
pad.h
proto.h

index 1fca12f..1e017e5 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1939,9 +1939,10 @@ Mpd      |PADOFFSET|pad_add_name |NN const char *name|const STRLEN len\
                                |NULLOK HV *ourstash
 : Only used in op.c
 pd     |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type
-: Only used in op.c
-Mpd    |void   |pad_check_dup  |NN const char *name|const STRLEN len\
-                               |const U32 flags|NN const HV *ourstash
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+sd     |void   |pad_check_dup  |NN const char *name|const STRLEN len\
+                               |const U32 flags|NULLOK const HV *ourstash
+#endif
 #ifdef DEBUGGING
 : Only used PAD_SETSV() in op.c
 pd     |void   |pad_setsv      |PADOFFSET po|NN SV* sv
diff --git a/embed.h b/embed.h
index f71e797..0ed9380 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define pad_undef              Perl_pad_undef
 #define pad_add_name           Perl_pad_add_name
 #define pad_add_anon           Perl_pad_add_anon
-#define pad_check_dup          Perl_pad_check_dup
+#endif
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#define pad_check_dup          S_pad_check_dup
+#endif
 #endif
 #ifdef DEBUGGING
 #ifdef PERL_CORE
 #define pad_undef(a)           Perl_pad_undef(aTHX_ a)
 #define pad_add_name(a,b,c,d,e)        Perl_pad_add_name(aTHX_ a,b,c,d,e)
 #define pad_add_anon(a,b)      Perl_pad_add_anon(aTHX_ a,b)
-#define pad_check_dup(a,b,c,d) Perl_pad_check_dup(aTHX_ a,b,c,d)
+#endif
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+#ifdef PERL_CORE
+#define pad_check_dup(a,b,c,d) S_pad_check_dup(aTHX_ a,b,c,d)
+#endif
 #endif
 #ifdef DEBUGGING
 #ifdef PERL_CORE
diff --git a/op.c b/op.c
index 6052186..93d78c9 100644 (file)
--- a/op.c
+++ b/op.c
@@ -406,13 +406,10 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
        }
     }
 
-    /* check for duplicate declaration */
-    pad_check_dup(name, len, is_our ? pad_add_OUR : 0,
-                 (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash));
-
     /* allocate a spare slot and store the name in that slot */
 
     off = pad_add_name(name, len,
+                      is_our ? pad_add_OUR :
                       PL_parser->in_my == KEY_state ? pad_add_STATE : 0,
                    PL_parser->in_my_stash,
                    (is_our
diff --git a/pad.c b/pad.c
index 4280c9f..3868359 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -393,10 +393,16 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
 
     PERL_ARGS_ASSERT_PAD_ADD_NAME;
 
-    if (flags & ~(pad_add_STATE))
+    if (flags & ~(pad_add_OUR|pad_add_STATE|pad_add_NO_DUP_CHECK))
        Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
                   (UV)flags);
 
+
+    if ((flags & pad_add_NO_DUP_CHECK) == 0) {
+       /* check for duplicate declaration */
+       pad_check_dup(name, len, flags & pad_add_OUR, ourstash);
+    }
+
     namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
 
     /* Until we're using the length for real, cross check that we're being told
@@ -555,10 +561,8 @@ C<is_our> indicates that the name to check is an 'our' declaration
 =cut
 */
 
-/* XXX DAPM integrate this into pad_add_name ??? */
-
 void
-Perl_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags,
+S_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags,
                   const HV *ourstash)
 {
     dVAR;
@@ -570,9 +574,7 @@ Perl_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags,
 
     ASSERT_CURPAD_ACTIVE("pad_check_dup");
 
-    if (flags & ~pad_add_OUR)
-       Perl_croak(aTHX_ "panic: pad_check_dup illegal flag bits 0x%" UVxf,
-                  (UV)flags);
+    assert((flags & ~pad_add_OUR) == 0);
 
     /* Until we're using the length for real, cross check that we're being told
        the truth.  */
diff --git a/pad.h b/pad.h
index e6cee11..7d05edc 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -114,11 +114,11 @@ typedef enum {
 
 #ifdef PERL_CORE
 
-/* flags for pad_add_name/pad_check_dup. SVf_UTF8 will also be valid in the
-   future.  */
+/* flags for pad_add_name. SVf_UTF8 will also be valid in the future.  */
 
 #  define pad_add_OUR  0x01    /* our declaration. */
 #  define pad_add_STATE        0x02    /* state declaration. */
+#  define pad_add_NO_DUP_CHECK 0x04    /* skip warning on dups. */
 
 #endif
 
diff --git a/proto.h b/proto.h
index 243495b..b7b33ab 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6116,12 +6116,13 @@ PERL_CALLCONV PADOFFSET Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 #define PERL_ARGS_ASSERT_PAD_ADD_ANON  \
        assert(sv)
 
-PERL_CALLCONV void     Perl_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags, const HV *ourstash)
-                       __attribute__nonnull__(pTHX_1)
-                       __attribute__nonnull__(pTHX_4);
+#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
+STATIC void    S_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags, const HV *ourstash)
+                       __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_PAD_CHECK_DUP \
-       assert(name); assert(ourstash)
+       assert(name)
 
+#endif
 #ifdef DEBUGGING
 PERL_CALLCONV void     Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
                        __attribute__nonnull__(pTHX_2);