This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update INSTALL regarding binary compatibility
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 1e7cdb5..544cd1a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2868,7 +2868,7 @@ S_scan_const(pTHX_ char *start)
                    goto default_action;
                }
 
-           /* eg. \132 indicates the octal constant 0x132 */
+           /* eg. \132 indicates the octal constant 0132 */
            case '0': case '1': case '2': case '3':
            case '4': case '5': case '6': case '7':
                {
@@ -2883,10 +2883,11 @@ S_scan_const(pTHX_ char *start)
            case 'o':
                {
                    STRLEN len;
+                   const char* error;
 
-                   char* error = grok_bslash_o(s, &uv, &len, 1);
+                   bool valid = grok_bslash_o(s, &uv, &len, &error, 1);
                    s += len;
-                   if (error) {
+                   if (! valid) {
                        yyerror(error);
                        continue;
                    }
@@ -6494,10 +6495,27 @@ Perl_yylex(pTHX)
                        const char *proto = SvPV_const(MUTABLE_SV(cv), protolen);
                        if (!protolen)
                            TERM(FUNC0SUB);
-                       if ((*proto == '$' || *proto == '_') && proto[1] == '\0')
-                           OPERATOR(UNIOPSUB);
                        while (*proto == ';')
                            proto++;
+                       if (
+                           (
+                               (
+                                   *proto == '$' || *proto == '_'
+                                || *proto == '*'
+                               )
+                            && proto[1] == '\0'
+                           )
+                        || (
+                            *proto == '\\' && proto[1] && proto[2] == '\0'
+                           )
+                       )
+                           OPERATOR(UNIOPSUB);
+                       if (*proto == '\\' && proto[1] == '[') {
+                           const char *p = proto + 2;
+                           while(*p && *p != ']')
+                               ++p;
+                           if(*p == ']' && !p[1]) OPERATOR(UNIOPSUB);
+                       }
                        if (*proto == '&' && *s == '{') {
                            if (PL_curstash)
                                sv_setpvs(PL_subname, "__ANON__");