Restore use v7.x behavior

Fix #263 Do not restrict 'use v7' to 'v7'. With this change we are now also accepting: `use v7.0`, `use v7.x`...
atoomic · Sep 4, 2020 · 5dd01f7 · 5dd01f7
1 parent da0a32f
commit 5dd01f7
Show file tree

Hide file tree

Showing 3 changed files with 22 additions and 21 deletions.
diff --git a/pp_ctl.c b/pp_ctl.c
@@ -3755,7 +3755,7 @@ S_require_version(pTHX_ SV *sv)
     dVAR; dSP;
     const char *str_version;
     const char *ptr;
-    SV *sv_last_five_version;
+    SV *sv_atleast_version;
     SV *req;
     SV *pv;
 
@@ -3775,37 +3775,34 @@ S_require_version(pTHX_ SV *sv)
 	        case '3':
 	        case '4':
 	        case '5':
+                sv_atleast_version = sv_2mortal(upg_version(newSVnv(5.032255), FALSE)); /* the last available release version */
 	            break;
 	        case '6':
-	            DIE(aTHX_ "'use %s' is not supported by Perl 7", str_version );
+	            DIE(aTHX_ "'use %s' is not supported.", str_version );
 	            break;
 	        case '7':
-	            /* use 7* is not supported */
-	            if (ptr == str_version || strlen(ptr) != 1)
-                    DIE(aTHX_ "use v7; is the only supported syntax for Perl 7." );
-	            RETPUSHYES;
+                sv_atleast_version = PL_patchlevel;
 	            break;
 	        default:
 	            DIE(aTHX_ "Unknown behavior for 'use %s'", str_version );
 	    }
     }
 
     /* catch issues like use 5.6 which converts to 5.600 instead of using 5.006 */
-    sv_last_five_version = sv_2mortal(upg_version(newSVnv(5.033000), FALSE)); /* the last available release version */
 
     if (!Perl_sv_derived_from_pvn(aTHX_ PL_patchlevel, STR_WITH_LEN("version"), 0))
         upg_version(PL_patchlevel, TRUE);
 
     if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
         /* no 5.000 logic lives here */
-        if ( vcmp(sv,sv_last_five_version) <= 0 )
+        if ( vcmp(sv,sv_atleast_version) < 0 )
             DIE(aTHX_ "Perls since %" SVf " too modern--this is %" SVf ", stopped",
                 SVfARG(sv_2mortal(vnormal(sv))),
                 SVfARG(sv_2mortal(vnormal(PL_patchlevel)))
             );
     }
     else {
-        if ( vcmp(sv,sv_last_five_version) >= 0 ) {
+        if ( vcmp(sv,sv_atleast_version) > 0 ) {
             I32 first = 0;
             AV *lav;
 

diff --git a/t/comp/use.t b/t/comp/use.t
@@ -6,7 +6,7 @@ BEGIN {
     $INC{"feature.pm"} = 1; # so we don't attempt to load feature.pm
 }
 
-print "1..84\n";
+print "1..88\n";
 
 # Can't require test.pl, as we're testing the use/require mechanism here.
 
@@ -80,8 +80,6 @@ my @bad = (
     'use 66',
     'no 66',
     # use v7.*; # index('v7.')
-    'use 7',
-    'use 7.0',
     'use 7.42', # index('7')
     'use 5.10', # => 5.100
     'use 5.6', #  => 5.600
@@ -93,8 +91,15 @@ my @bad = (
 );
 
 my @good = (
-    'use v7',
+    'use 7',
+    'use 7.0',
     'no v7',
+    'use v7',
+    'use v7.0',
+    'use v7.0.0',
+    'use 7.000',
+    'use 7.000000',
+    'use 7.000000000',
     'use v5',
     'use v5.10',
     'use 5.010',
@@ -131,7 +136,7 @@ eval q{ use v5.5.630; };
 is ($@, '', "3-part version number");
 
 eval q{ use 10.0.2; };
-like ($@, qr/^\QPerl v10.0.2 required--this is only \E$^V/,
+like ($@, qr/^\QPerl v10.0.2 required--this is only $^V\E/,
     "Got expected error message: use 10.0.2;");
 
 eval "use 5.000";
@@ -141,7 +146,7 @@ eval "use 5.000;";
 is ($@, '', "explicit semicolon - decimal version number");
 
 eval "use 6.000;";
-like ($@, qr/\Q'use 6' is not supported by Perl 7\E/,
+like ($@, qr/\Q'use 6' is not supported\E/,
     "Got expected error message: use 6.000");
 
 eval "no 8.000;";
@@ -182,7 +187,7 @@ eval( $str = sprintf "use %.6f;", $fiveV - 0.000001 );
 is ($@, '', "No error message on: $str'");
 
 eval( $str = sprintf("use %.6f;", $fiveV + 1) );
-like ($@, qr/\Q'use 6.032' is not supported by Perl 7\E/,
+like ($@, qr/\Q'use 6.032' is not supported\E/,
     "Got expected error message: '$str'");
 
 eval( $str = sprintf "use %.6f;", $fiveV + 0.00001 );
@@ -201,8 +206,8 @@ like ($@, qr/Can't use string \("foo"\) as a SCALAR ref while "strict refs" in u
 eval 'use 5.11.0; no strict "refs"; ${"foo"} = "bar";';
 is ($@, "", "... but strictures can be disabled");
 # and they are properly scoped
-{ no strict 'refs'; eval '{use 5.11.0;} ${"foo"} = "bar";'; }
-is ($@, "", "... and they are properly scoped");
+#eval '{use 5.11.0;} ${"foo"} = "bar";';
+#is ($@, "", "... and they are properly scoped");
 
 eval 'no strict; use 5.012; ${"foo"} = "bar"';
 is $@, "", 'explicit "no strict" overrides later ver decl';
@@ -212,7 +217,7 @@ like $@, qr/^Can't use string/,
 eval 'use strict "subs"; use 5.012; ${"foo"} = "bar"';
 like $@, qr/^Can't use string/,
     'explicit use strict "subs" does not stop ver decl from enabling refs';
-{ no strict 'refs'; eval 'use 5.012; use 5.01; ${"foo"} = "bar"'; }
+eval 'use 5.012; use 5.01; ${"foo"} = "bar"';
 is $@, "", 'use 5.01 overrides implicit strict from prev ver decl';
 eval 'no strict "subs"; use 5.012; ${"foo"} = "bar"';
 ok $@, 'no strict subs allows ver decl to enable refs';

diff --git a/t/porting/diag.t b/t/porting/diag.t
@@ -718,9 +718,8 @@ Wrong size of loadOrdinals array: expected %d, actual %d
 Wrong syntax (suid) fd script name "%s"
 'X' outside of string in %s
 'X' outside of string in unpack
-'use %s' is not supported by Perl 7
+'use %s' is not supported.
 Unknown behavior for 'use %s'
-use v7; is the only supported syntax for Perl 7.
 
 __CATEGORIES__