core_prototype: Remove special cases for lock and tie

core_prototype now calls scalar_mod_type in the OA_SCALARREF case.

For core functions, the only thing distinguishing the \$ and
\[$@%*] cases during parsing is the call to scalar_mod_type in
op_lvalue_flags.  So calling this same function here just works.

diff --git a/embed.fnc b/embed.fnc
index 1f0ed0e..cd4f0a7 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1630,7 +1630,7 @@ sR        |OP*    |search_const   |NN OP *o
 sR     |OP*    |new_logop      |I32 type|I32 flags|NN OP **firstp|NN OP **otherp
 s      |void   |simplify_sort  |NN OP *o
 s      |const char*    |gv_ename       |NN GV *gv
-sRn    |bool   |scalar_mod_type|NN const OP *o|I32 type
+sRn    |bool   |scalar_mod_type|NULLOK const OP *o|I32 type
 s      |OP *   |my_kid         |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp
 s      |OP *   |dup_attrlist   |NN OP *o
 s      |void   |apply_attrs    |NN HV *stash|NN SV *target|NULLOK OP *attrs|bool for_my

diff --git a/op.c b/op.c
index 5b39492..d44b6a2 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1781,7 +1781,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 STATIC bool
 S_scalar_mod_type(const OP *o, I32 type)
 {
-    PERL_ARGS_ASSERT_SCALAR_MOD_TYPE;
+    assert(o || type != OP_SASSIGN);
 
     switch (type) {
     case OP_SASSIGN:
@@ -10236,10 +10236,6 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
        retsetpvs(";+");
     case KEY_splice:
        retsetpvs("+;$$@");
-    case KEY_lock: case KEY_tied: case KEY_untie:
-       retsetpvs("\\[$@%*]");
-    case KEY_tie:
-       retsetpvs("\\[$@%*]$@");
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
        retsetpvs("");
     case KEY_readpipe:
@@ -10272,7 +10268,16 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len,
        ) {
            str[n++] = '\\';
        }
-       str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
+       if ((oa & (OA_OPTIONAL - 1)) == OA_SCALARREF
+        && !scalar_mod_type(NULL, i)) {
+           str[n++] = '[';
+           str[n++] = '$';
+           str[n++] = '@';
+           str[n++] = '%';
+           str[n++] = '*';
+           str[n++] = ']';
+       }
+       else str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
        oa = oa >> 4;
     }
     if (defgv && str[0] == '$')

diff --git a/proto.h b/proto.h
index 750b792..d060f7e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5575,10 +5575,7 @@ STATIC void      S_process_special_blocks(pTHX_ const char *const fullname, GV *const
 STATIC OP*     S_ref_array_or_hash(pTHX_ OP* cond);
 STATIC OP*     S_refkids(pTHX_ OP* o, I32 type);
 STATIC bool    S_scalar_mod_type(const OP *o, I32 type)
-                       __attribute__warn_unused_result__
-                       __attribute__nonnull__(1);
-#define PERL_ARGS_ASSERT_SCALAR_MOD_TYPE       \
-       assert(o)
+                       __attribute__warn_unused_result__;
 
 STATIC OP*     S_scalarboolean(pTHX_ OP *o)
                        __attribute__nonnull__(pTHX_1);