Added a private function is_sub_with_sig
authorPeter Martini <PeterCMartini@GMail.com>
Wed, 26 Sep 2012 21:26:19 +0000 (17:26 -0400)
committerPeter Martini <PeterCMartini@GMail.com>
Wed, 17 Oct 2012 20:36:11 +0000 (16:36 -0400)
This is intended to be used only at compile time,
to leave room for an optimization to turn
sub foo { my ($bar, $baz) = @_; } into
sub foo($bar,$baz){ }
in a check routine run after compilation, and the
two have different syntax.

embed.fnc
embed.h
pp_ctl.c
proto.h

index 7d4070e..029eb93 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -582,6 +582,8 @@ Ap  |void   |init_tm        |NN struct tm *ptm
 AnpPR  |char*  |instr          |NN const char* big|NN const char* little
 : Used in sv.c
 p      |bool   |io_close       |NN IO* io|bool not_implicit
+: Used in toke.c
+pR     |bool   |is_sub_with_sig
 : Used in perly.y
 pR     |OP*    |invert         |NULLOK OP* cmd
 ApR    |I32    |is_lvalue_sub
diff --git a/embed.h b/embed.h
index d57604a..deb04f8 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define intro_my()             Perl_intro_my(aTHX)
 #define invert(a)              Perl_invert(aTHX_ a)
 #define io_close(a,b)          Perl_io_close(aTHX_ a,b)
+#define is_sub_with_sig()      Perl_is_sub_with_sig(aTHX)
 #define jmaybe(a)              Perl_jmaybe(aTHX_ a)
 #define keyword(a,b,c)         Perl_keyword(aTHX_ a,b,c)
 #define list(a)                        Perl_list(aTHX_ a)
index 1aaa261..6e5c9e7 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1381,6 +1381,18 @@ Perl_block_gimme(pTHX)
     }
 }
 
+bool
+Perl_is_sub_with_sig(pTHX)
+{
+    dVAR;
+    const CV * const cv = CvEVAL(PL_compcv) ? CvOUTSIDE(PL_compcv) : PL_compcv;
+
+    if (PadlistNAMECNT(CvPADLIST(cv)))
+       return TRUE;
+    else
+       return FALSE;
+}
+
 I32
 Perl_is_lvalue_sub(pTHX)
 {
diff --git a/proto.h b/proto.h
index 0651625..209f8d8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1662,6 +1662,9 @@ PERL_CALLCONV bool        Perl_is_ascii_string(const U8 *s, STRLEN len)
 PERL_CALLCONV I32      Perl_is_lvalue_sub(pTHX)
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV bool     Perl_is_sub_with_sig(pTHX)
+                       __attribute__warn_unused_result__;
+
 PERL_CALLCONV bool     Perl_is_uni_alnum(pTHX_ UV c)
                        __attribute__warn_unused_result__
                        __attribute__pure__;