alphabetically sort flag descriptions in embed.fnc

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 1398439..9df0ff2 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2093,7 +2093,13 @@ S_force_version(pTHX_ char *s, int guessing)
 #endif
         if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
            SV *ver;
+#ifdef USE_LOCALE_NUMERIC
+           char *loc = setlocale(LC_NUMERIC, "C");
+#endif
             s = scan_num(s, &pl_yylval);
+#ifdef USE_LOCALE_NUMERIC
+           setlocale(LC_NUMERIC, loc);
+#endif
             version = pl_yylval.opval;
            ver = cSVOPx(version)->op_sv;
            if (SvPOK(ver) && !SvNIOK(ver)) {
@@ -2130,6 +2136,53 @@ S_force_version(pTHX_ char *s, int guessing)
 }
 
 /*
+ * S_force_strict_version
+ * Forces the next token to be a version number using strict syntax rules.
+ */
+
+STATIC char *
+S_force_strict_version(pTHX_ char *s)
+{
+    dVAR;
+    OP *version = NULL;
+#ifdef PERL_MAD
+    I32 startoff = s - SvPVX(PL_linestr);
+#endif
+    const char *errstr = NULL;
+
+    PERL_ARGS_ASSERT_FORCE_STRICT_VERSION;
+
+    while (isSPACE(*s)) /* leading whitespace */
+       s++;
+
+    if (is_STRICT_VERSION(s,&errstr)) {
+       SV *ver = newSV(0);
+       s = (char *)scan_version(s, ver, 0);
+       version = newSVOP(OP_CONST, 0, ver);
+    }
+    else if ( (*s != ';' && *s != '}' ) && (s = SKIPSPACE1(s), (*s != ';' && *s !='}' ))) {
+       PL_bufptr = s;
+       if (errstr)
+           yyerror(errstr); /* version required */
+       return s;
+    }
+
+#ifdef PERL_MAD
+    if (PL_madskills && !version) {
+       sv_free(PL_nextwhite);  /* let next token collect whitespace */
+       PL_nextwhite = 0;
+       s = SvPVX(PL_linestr) + startoff;
+    }
+#endif
+    /* NOTE: The parser sees the package name and the VERSION swapped */
+    start_force(PL_curforce);
+    NEXTVAL_NEXTTOKE.opval = version;
+    force_next(WORD);
+
+    return s;
+}
+
+/*
  * S_tokeq
  * Tokenize a quoted string passed in as an SV.  It finds the next
  * chunk, up to end of string or a backslash.  It may make a new
@@ -6961,7 +7014,8 @@ Perl_yylex(pTHX)
 
        case KEY_package:
            s = force_word(s,WORD,FALSE,TRUE,FALSE);
-           s = force_version(s, FALSE);
+           s = SKIPSPACE1(s);
+           s = force_strict_version(s);
            OPERATOR(PACKAGE);
 
        case KEY_pipe:
@@ -7348,7 +7402,7 @@ Perl_yylex(pTHX)
                    bool must_be_last = FALSE;
                    bool underscore = FALSE;
                    bool seen_underscore = FALSE;
-                   const bool warnsyntax = ckWARN(WARN_SYNTAX);
+                   const bool warnillegalproto = ckWARN(WARN_ILLEGALPROTO);
 
                    s = scan_str(s,!!PL_madskills,FALSE);
                    if (!s)
@@ -7360,7 +7414,7 @@ Perl_yylex(pTHX)
                        if (!isSPACE(*p)) {
                            d[tmp++] = *p;
 
-                           if (warnsyntax) {
+                           if (warnillegalproto) {
                                if (must_be_last)
                                    proto_after_greedy_proto = TRUE;
                                if (!strchr("$@%*;[]&\\_", *p)) {
@@ -7393,11 +7447,11 @@ Perl_yylex(pTHX)
                    }
                    d[tmp] = '\0';
                    if (proto_after_greedy_proto)
-                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                       Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
                                    "Prototype after '%c' for %"SVf" : %s",
                                    greedy_proto, SVfARG(PL_subname), d);
                    if (bad_proto)
-                       Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
+                       Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
                                    "Illegal character %sin prototype for %"SVf" : %s",
                                    seen_underscore ? "after '_' " : "",
                                    SVfARG(PL_subname), d);