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

p4raw-id: //depot/perl@25344

9 files changed, 75 insertions, 37 deletions

diff --git a/embed.fnc b/embed.fnc
index 690977b17e..9ff584af18 100644
--- 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 5faec5aca9..626b213684 100644
--- 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 e72a1809db..f1fbbd9538 100644
--- 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 c0cca4e7b7..c6b85a32cd 100644
--- 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 5a39d1e220..2c4937f1d9 100644
--- 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 2493fa804b..0e31353d09 100644
--- 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 dc9fc2157d..437d904fa5 100644
--- 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 fb378b2979..eec6fe05c0 100755
--- 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 1b16de04ba..cb2c589e94 100644
--- 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: