Add length and flags arguments to Perl_pad_check_dup().

Currently only pad_add_OUR is used. The length is cross-checked against
strlen() on the pointer, but the intent is to re-work the entire pad API to
be UTF-8 aware, from the current situation of char * pointers only.

diff --git a/embed.fnc b/embed.fnc
index 440ada4..ef8cc8e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1938,7 +1938,8 @@ pd        |PADOFFSET|pad_add_name |NN const char *name\
 : Only used in op.c
 pd     |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type
 : Only used in op.c
-pd     |void   |pad_check_dup  |NN const char* name|bool is_our|NN const HV* ourstash
+Mpd    |void   |pad_check_dup  |NN const char *name|const STRLEN len\
+                               |const U32 flags|NN const HV *ourstash
 #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 9938096..95c93f4 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -4089,7 +4089,7 @@
 #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)   Perl_pad_check_dup(aTHX_ a,b,c)
+#define pad_check_dup(a,b,c,d) Perl_pad_check_dup(aTHX_ a,b,c,d)
 #endif
 #ifdef DEBUGGING
 #ifdef PERL_CORE

diff --git a/op.c b/op.c
index b42bb54..aa5994d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -407,7 +407,8 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
     }
 
     /* check for duplicate declaration */
-    pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash));
+    pad_check_dup(name, len, is_our ? pad_add_OUR : 0,
+                 (PL_curstash ? PL_curstash : PL_defstash));
 
     /* allocate a spare slot and store the name in that slot */
 

diff --git a/pad.c b/pad.c
index becbdc9..e9c83fe 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -540,15 +540,27 @@ C<is_our> indicates that the name to check is an 'our' declaration
 /* XXX DAPM integrate this into pad_add_name ??? */
 
 void
-Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
+Perl_pad_check_dup(pTHX_ const char *name, const STRLEN len, const U32 flags,
+                  const HV *ourstash)
 {
     dVAR;
     SV         **svp;
     PADOFFSET  top, off;
+    const U32  is_our = flags & pad_add_OUR;
 
     PERL_ARGS_ASSERT_PAD_CHECK_DUP;
 
     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);
+
+    /* Until we're using the length for real, cross check that we're being told
+       the truth.  */
+    PERL_UNUSED_ARG(len);
+    assert(strlen(name) == len);
+
     if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
        return; /* nothing to check */
 

diff --git a/pad.h b/pad.h
index 352a592..074d52e 100644 (file)
--- a/pad.h
+++ b/pad.h
@@ -112,6 +112,17 @@ typedef enum {
        padtidy_FORMAT          /* or a format */
 } padtidy_type;
 
+#ifdef PERL_CORE
+
+/* flags for pad_add_name/pad_check_dup. 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_FAKE 0x04
+
+#endif
+
 /* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine
  * whether PL_comppad and PL_curpad are consistent and whether they have
  * active values */

diff --git a/proto.h b/proto.h
index 20f8551..50f72a1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6111,9 +6111,9 @@ 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, bool is_our, const HV* ourstash)
+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_3);
+                       __attribute__nonnull__(pTHX_4);
 #define PERL_ARGS_ASSERT_PAD_CHECK_DUP \
        assert(name); assert(ourstash)