Add the "no 6" / "no v6" syntax.

p4raw-id: //depot/perl@25344

diff --git a/embed.fnc b/embed.fnc
index 690977b..9ff584a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1315,6 +1315,7 @@ sR        |I32    |sublex_push
 sR     |I32    |sublex_start
 sR     |char * |filter_gets    |NN SV *sv|NN PerlIO *fp|STRLEN append
 sR     |HV *   |find_in_my_stash|NN const char *pkgname|I32 len
+sR     |char * |tokenize_use   |int|NN char*
 s      |SV*    |new_constant   |NULLOK const char *s|STRLEN len|NN const char *key|NN SV *sv \
                                |NULLOK SV *pv|NULLOK const char *type
 #  if defined(DEBUGGING)

diff --git a/embed.h b/embed.h
index 5faec5a..626b213 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1366,6 +1366,7 @@
 #define sublex_start           S_sublex_start
 #define filter_gets            S_filter_gets
 #define find_in_my_stash       S_find_in_my_stash
+#define tokenize_use           S_tokenize_use
 #define new_constant           S_new_constant
 #endif
 #  if defined(DEBUGGING)
@@ -3350,6 +3351,7 @@
 #define sublex_start()         S_sublex_start(aTHX)
 #define filter_gets(a,b,c)     S_filter_gets(aTHX_ a,b,c)
 #define find_in_my_stash(a,b)  S_find_in_my_stash(aTHX_ a,b)
+#define tokenize_use(a,b)      S_tokenize_use(aTHX_ a,b)
 #define new_constant(a,b,c,d,e,f)      S_new_constant(aTHX_ a,b,c,d,e,f)
 #endif
 #  if defined(DEBUGGING)

diff --git a/ext/B/t/concise-xs.t b/ext/B/t/concise-xs.t
index e72a180..f1fbbd9 100644 (file)
--- a/ext/B/t/concise-xs.t
+++ b/ext/B/t/concise-xs.t
@@ -90,14 +90,14 @@ use Getopt::Std;
 use Carp;
 use Test::More tests => ( 1 * !!$Config::Config{useithreads}
                          + 2 * ($] > 5.009)
-                         + 776);
+                         + 777 );
 
 require_ok("B::Concise");
 
 my $testpkgs = {
-    
+
     Digest::MD5 => [qw/ ! import /],
-      
+
     B => [qw/ ! class clearsym compile_stats debug objsym parents
              peekop savesym timing_info walkoptree_exec
              walkoptree_slow walksymtable /],
@@ -136,7 +136,7 @@ usage: PERL_CORE=1 ./perl ext/B/t/concise-xs.t [-av] [module-list]
     -a : runs all modules in CoreList
     -c  : writes test corrections as a Data::Dumper expression
     -r <file>  : reads file of tests, as written by -c
-    <args>     : additional modules are loaded and tested 
+    <args>     : additional modules are loaded and tested
        (will report failures, since no XS funcs are known aprior)
 
 EODIE
@@ -153,7 +153,7 @@ my %report;
 if ($opts{r}) {
     my $refpkgs = require "$opts{r}";
     $testpkgs->{$_} = $refpkgs->{$_} foreach keys %$refpkgs;
-}    
+}
 
 unless ($opts{a}) {
     unless (@argpkgs) {
@@ -178,10 +178,10 @@ sub test_pkg {
        warn "no XS/non-XS function list given, assuming empty XS list";
        $xslist = [''];
     }
-    
+
     my $assumeXS = 0;  # assume list enumerates XS funcs, not perl ones
     $assumeXS = 1      if $xslist->[0] and $xslist->[0] eq '!';
-    
+
     # build %stash: keys are func-names, vals: 1 if XS, 0 if not
     my (%stash) = map
        ( ($_ => $assumeXS)
@@ -189,10 +189,10 @@ sub test_pkg {
               => grep !/__ANON__/              # but not anon subs
               => keys %{$pkg_name.'::'}        # from symbol table
               ));
-    
+
     # now invert according to supplied list
     $stash{$_} = int ! $assumeXS foreach @$xslist;
-    
+
     # and cleanup cruft (easier than preventing)
     delete @stash{'!',''};
 

diff --git a/op.c b/op.c
index c0cca4e..c6b85a3 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3057,6 +3057,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
        imop = arg;             /* no import on explicit () */
     else if (SvNIOKp(((SVOP*)idop)->op_sv)) {
        imop = Nullop;          /* use 5.0; */
+       if (!aver)
+           idop->op_private |= OPpCONST_NOVER;
     }
     else {
        SV *meth;

diff --git a/op.h b/op.h
index 5a39d1e..2c4937f 100644 (file)
--- a/op.h
+++ b/op.h
@@ -184,6 +184,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpITER_REVERSED       4       /* for (reverse ...) */
 
 /* Private for OP_CONST */
+#define        OPpCONST_NOVER          2       /* no 6; */
 #define        OPpCONST_SHORTCIRCUIT   4       /* eg the constant 5 in (5 || foo) */
 #define        OPpCONST_STRICT         8       /* bearword subject to strict 'subs' */
 #define OPpCONST_ENTERED       16      /* Has been entered as symbol. */

diff --git a/pp_ctl.c b/pp_ctl.c
index 2493fa8..0e31353 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3102,9 +3102,16 @@ PP(pp_require)
        sv = new_version(sv);
        if (!sv_derived_from(PL_patchlevel, "version"))
            (void *)upg_version(PL_patchlevel);
-       if ( vcmp(sv,PL_patchlevel) > 0 )
-           DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-               vnormal(sv), vnormal(PL_patchlevel));
+       if (cUNOP->op_first->op_private & OPpCONST_NOVER) {
+           if ( vcmp(sv,PL_patchlevel) < 0 )
+               DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
+                   vnormal(sv), vnormal(PL_patchlevel));
+       }
+       else {
+           if ( vcmp(sv,PL_patchlevel) > 0 )
+               DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
+                   vnormal(sv), vnormal(PL_patchlevel));
+       }
 
            RETPUSHYES;
     }

diff --git a/proto.h b/proto.h
index dc9fc21..437d904 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3451,6 +3451,10 @@ STATIC HV *      S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
                        __attribute__warn_unused_result__
                        __attribute__nonnull__(pTHX_1);
 
+STATIC char *  S_tokenize_use(pTHX_ int, char*)
+                       __attribute__warn_unused_result__
+                       __attribute__nonnull__(pTHX_2);
+
 STATIC SV*     S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type)
                        __attribute__nonnull__(pTHX_3)
                        __attribute__nonnull__(pTHX_4);

diff --git a/t/comp/use.t b/t/comp/use.t
index fb378b2..eec6fe0 100755 (executable)
--- a/t/comp/use.t
+++ b/t/comp/use.t
@@ -5,7 +5,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-print "1..28\n";
+print "1..31\n";
 
 my $i = 1;
 eval "use 5.000";      # implicit semicolon
@@ -22,6 +22,25 @@ if ($@) {
 }
 print "ok ",$i++,"\n";
 
+eval "use 6.000;";
+unless ($@ =~ /Perl v6\.0\.0 required--this is only \Q$^V\E, stopped/) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval "no 6.000;";
+if ($@) {
+    print STDERR $@,"\n";
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
+eval "no 5.000;";
+unless ($@ =~ /Perls since v5\.0\.0 too modern--this is \Q$^V\E, stopped/) {
+    print "not ";
+}
+print "ok ",$i++,"\n";
+
 eval sprintf "use %.6f;", $];
 if ($@) {
     print STDERR $@,"\n";

diff --git a/toke.c b/toke.c
index 1b16de0..cb2c589 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2293,6 +2293,30 @@ S_find_in_my_stash(pTHX_ const char *pkgname, I32 len)
     return gv_stashpv(pkgname, FALSE);
 }
 
+STATIC char *
+S_tokenize_use(int is_use, char *s) {
+    if (PL_expect != XSTATE)
+       yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
+                   is_use ? "use" : "no"));
+    s = skipspace(s);
+    if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
+       s = force_version(s, TRUE);
+       if (*s == ';' || (s = skipspace(s), *s == ';')) {
+           PL_nextval[PL_nexttoke].opval = Nullop;
+           force_next(WORD);
+       }
+       else if (*s == 'v') {
+           s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_version(s, FALSE);
+       }
+    }
+    else {
+       s = force_word(s,WORD,FALSE,TRUE,FALSE);
+       s = force_version(s, FALSE);
+    }
+    yylval.ival = is_use;
+    return s;
+}
 #ifdef DEBUGGING
     static const char* const exp_name[] =
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
@@ -4871,11 +4895,7 @@ Perl_yylex(pTHX)
            Eop(OP_SNE);
 
        case KEY_no:
-           if (PL_expect != XSTATE)
-               yyerror("\"no\" not allowed in expression");
-           s = force_word(s,WORD,FALSE,TRUE,FALSE);
-           s = force_version(s, FALSE);
-           yylval.ival = 0;
+           s = tokenize_use(0, s);
            OPERATOR(USE);
 
        case KEY_not:
@@ -5407,25 +5427,7 @@ Perl_yylex(pTHX)
            LOP(OP_UNSHIFT,XTERM);
 
        case KEY_use:
-           if (PL_expect != XSTATE)
-               yyerror("\"use\" not allowed in expression");
-           s = skipspace(s);
-           if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
-               s = force_version(s, TRUE);
-               if (*s == ';' || (s = skipspace(s), *s == ';')) {
-                   PL_nextval[PL_nexttoke].opval = Nullop;
-                   force_next(WORD);
-               }
-               else if (*s == 'v') {
-                   s = force_word(s,WORD,FALSE,TRUE,FALSE);
-                   s = force_version(s, FALSE);
-               }
-           }
-           else {
-               s = force_word(s,WORD,FALSE,TRUE,FALSE);
-               s = force_version(s, FALSE);
-           }
-           yylval.ival = 1;
+           s = tokenize_use(1, s);
            OPERATOR(USE);
 
        case KEY_values: