Implement builtin version bundles

builtin.c

@@ -16,8 +16,12 @@
 
 #include "XSUB.h"
 
+/* copied from op.c */
+#define SHORTVER(maj,min) (((maj) << 8) | (min))
+
 struct BuiltinFuncDescriptor {
     const char *name;
+    U16 since_ver;
     XSUBADDR_t xsub;
     OP *(*checker)(pTHX_ OP *, GV *, SV *);
     IV ckval;
@@ -488,35 +492,93 @@ static OP *ck_builtin_funcN(pTHX_ OP *entersubop, GV *namegv, SV *ckobj)
 
 static const char builtin_not_recognised[] = "'%" SVf "' is not recognised as a builtin function";
 
+#define NO_BUNDLE SHORTVER(255,255)
+
 static const struct BuiltinFuncDescriptor builtins[] = {
     /* constants */
-    { "true",   &XS_builtin_true,   &ck_builtin_const, BUILTIN_CONST_TRUE,  false },
-    { "false",  &XS_builtin_false,  &ck_builtin_const, BUILTIN_CONST_FALSE, false },
+    { "true",  SHORTVER(5,39), &XS_builtin_true,   &ck_builtin_const, BUILTIN_CONST_TRUE,  false },
+    { "false", SHORTVER(5,39), &XS_builtin_false,  &ck_builtin_const, BUILTIN_CONST_FALSE, false },
 
     /* unary functions */
-    { "is_bool",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_BOOL,    true  },
-    { "weaken",     &XS_builtin_func1_void,   &ck_builtin_func1, OP_WEAKEN,     false },
-    { "unweaken",   &XS_builtin_func1_void,   &ck_builtin_func1, OP_UNWEAKEN,   false },
-    { "is_weak",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_WEAK,    false },
-    { "blessed",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_BLESSED,    false },
-    { "refaddr",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFADDR,    false },
-    { "reftype",    &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFTYPE,    false },
-    { "ceil",       &XS_builtin_func1_scalar, &ck_builtin_func1, OP_CEIL,       false },
-    { "floor",      &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR,      false },
-    { "is_tainted", &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_TAINTED, false },
-    { "trim",       &XS_builtin_trim,         &ck_builtin_func1, 0,             false },
-    { "stringify",  &XS_builtin_func1_scalar, &ck_builtin_func1, OP_STRINGIFY,  true },
-
-    { "created_as_string", &XS_builtin_created_as_string, &ck_builtin_func1, 0, true },
-    { "created_as_number", &XS_builtin_created_as_number, &ck_builtin_func1, 0, true },
+    { "is_bool",         NO_BUNDLE, &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_BOOL,    true  },
+    { "weaken",     SHORTVER(5,39), &XS_builtin_func1_void,   &ck_builtin_func1, OP_WEAKEN,     false },
+    { "unweaken",   SHORTVER(5,39), &XS_builtin_func1_void,   &ck_builtin_func1, OP_UNWEAKEN,   false },
+    { "is_weak",    SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_WEAK,    false },
+    { "blessed",    SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_BLESSED,    false },
+    { "refaddr",    SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFADDR,    false },
+    { "reftype",    SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_REFTYPE,    false },
+    { "ceil",       SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_CEIL,       false },
+    { "floor",      SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_FLOOR,      false },
+    { "is_tainted", SHORTVER(5,39), &XS_builtin_func1_scalar, &ck_builtin_func1, OP_IS_TAINTED, false },
+    { "trim",       SHORTVER(5,39), &XS_builtin_trim,         &ck_builtin_func1, 0,             false },
+    { "stringify",       NO_BUNDLE, &XS_builtin_func1_scalar, &ck_builtin_func1, OP_STRINGIFY,  true },
+
+    { "created_as_string", NO_BUNDLE, &XS_builtin_created_as_string, &ck_builtin_func1, 0, true },
+    { "created_as_number", NO_BUNDLE, &XS_builtin_created_as_number, &ck_builtin_func1, 0, true },
 
     /* list functions */
-    { "indexed",          &XS_builtin_indexed,          &ck_builtin_funcN, 0, false },
-    { "export_lexically", &XS_builtin_export_lexically, NULL,              0, true },
+    { "indexed",          SHORTVER(5,39), &XS_builtin_indexed,          &ck_builtin_funcN, 0, false },
+    { "export_lexically",      NO_BUNDLE, &XS_builtin_export_lexically, NULL,              0, true },
 
-    { NULL, NULL, NULL, 0, false }
+    { NULL, 0, NULL, NULL, 0, false }
 };
 
+static bool S_parse_version(const char *vstr, int *vmajor, int *vminor)
+{
+    /* Parse a string like "5.35" to yield 5 and 35. Ignores an optional
+     * trailing third component e.g. "5.35.7". Returns false on parse errors.
+     */
+
+    size_t len;
+
+    if(sscanf(vstr, "%d.%d%zn", vmajor, vminor, &len) < 2)
+        return FALSE;
+
+    if(*vminor > 255)
+        return FALSE;
+
+    vstr += len;
+
+    if(vstr[0] == '.') {
+        vstr++;
+
+        int _dummy;
+        if(sscanf(vstr, "%d%zn", &_dummy, &len) < 1)
+            return FALSE;
+        if(_dummy > 255)
+            return FALSE;
+
+        vstr += len;
+    }
+
+    if(vstr[0])
+        return FALSE;
+
+    return TRUE;
+}
+
+#define import_sym(sym)  S_import_sym(aTHX_ sym)
+static void S_import_sym(pTHX_ SV *sym)
+{
+    SV *ampname = sv_2mortal(Perl_newSVpvf(aTHX_ "&%" SVf, SVfARG(sym)));
+    SV *fqname = sv_2mortal(Perl_newSVpvf(aTHX_ "builtin::%" SVf, SVfARG(sym)));
+
+    CV *cv = get_cv(SvPV_nolen(fqname), SvUTF8(fqname) ? SVf_UTF8 : 0);
+    if(!cv)
+        Perl_croak(aTHX_ builtin_not_recognised, sym);
+
+    export_lexical(ampname, (SV *)cv);
+}
+
+#define import_builtin_bundle(ver)  S_import_builtin_bundle(aTHX_ ver)
+static void S_import_builtin_bundle(pTHX_ U16 ver)
+{
+    for(int i = 0; builtins[i].name; i++) {
+        if(builtins[i].since_ver <= ver)
+            import_sym(newSVpvn_flags(builtins[i].name, strlen(builtins[i].name), SVs_TEMP));
+    }
+}
+
 XS(XS_builtin_import);
 XS(XS_builtin_import)
 {
@@ -534,14 +596,25 @@ XS(XS_builtin_import)
         if(strEQ(sympv, "import") || strEQ(sympv, "unimport"))
             Perl_croak(aTHX_ builtin_not_recognised, sym);
 
-        SV *ampname = sv_2mortal(Perl_newSVpvf(aTHX_ "&%" SVf, SVfARG(sym)));
-        SV *fqname = sv_2mortal(Perl_newSVpvf(aTHX_ "builtin::%" SVf, SVfARG(sym)));
+        if(sympv[0] == ':') {
+            int vmajor, vminor;
+            if(!S_parse_version(sympv + 1, &vmajor, &vminor))
+                Perl_croak(aTHX_ "Invalid version bundle %s", sympv);
 
-        CV *cv = get_cv(SvPV_nolen(fqname), SvUTF8(fqname) ? SVf_UTF8 : 0);
-        if(!cv)
-            Perl_croak(aTHX_ builtin_not_recognised, sym);
+            U16 want_ver = SHORTVER(vmajor, vminor);
+
+            if(want_ver < SHORTVER(5,39) ||
+                    /* round up devel version to next major release; e.g. 5.39 => 5.40 */
+                    want_ver > SHORTVER(PERL_REVISION, PERL_VERSION + (PERL_VERSION % 2)))
+                Perl_croak(aTHX_ "Builtin version bundle \"%s\" is not supported by Perl " PERL_VERSION_STRING,
+                        sympv);
+
+            import_builtin_bundle(want_ver);
+
+            continue;
+        }
 
-        export_lexical(ampname, (SV *)cv);
+        import_sym(sym);
     }
 
     finish_export_lexical();

lib/builtin.pm

@@ -1,4 +1,4 @@
-package builtin 0.010;
+package builtin 0.011;
 
 use strict;
 use warnings;
@@ -29,6 +29,8 @@ builtin - Perl pragma to import built-in utility functions
         export_lexically
     );
 
+    use builtin ':5.40';  # most of the above
+
 =head1 DESCRIPTION
 
 Perl provides several utility functions in the C<builtin> package. These are
@@ -85,6 +87,23 @@ Imported symbols can also be removed again by using the C<no> keyword:
     no builtin 'true';
     # true() is no longer aliased from builtin
 
+=head2 Version Bundles
+
+The entire set of builtin functions that were considered non-experimental by a
+version of perl can be imported all at once, by requesting a version bundle.
+This is done by giving the perl release version (without its subversion
+suffix) after a colon character:
+
+    use builtin ':5.40';
+
+The following bundles currently exist:
+
+    Version    Includes
+    -------    --------
+
+    :5.40      true false weaken unweaken is_weak blessed refaddr reftype
+               ceil floor is_tainted trim indexed
+
 =head1 FUNCTIONS
 
 =head2 true

lib/builtin.t

@@ -444,6 +444,18 @@ TODO: {
     is($HASH{key}, "val", 'Lexically exported hash is accessible');
 }
 
+# version bundles
+{
+    use builtin ':5.39';
+    ok(true, 'true() is available from :5.39 bundle');
+
+    # parse errors
+    foreach my $bundle (qw( :x :5.x :5.36x :5.36.1000 :5.1000 :5.36.1.2 )) {
+        ok(!defined eval "use builtin '$bundle';", $bundle.' is invalid bundle');
+        like($@, qr/^Invalid version bundle \Q$bundle\E at /);
+    }
+}
+
 # vim: tabstop=4 shiftwidth=4 expandtab autoindent softtabstop=4
 
 done_testing();

pod/perldiag.pod

@@ -664,6 +664,12 @@ is currently being compiled. Since this method is used to remove
 previously-introduced lexical subroutines from the scope currently being
 compiled, this is not going to have any effect.
 
+=item Builtin version bundle "%s" is not supported by Perl
+
+(F) You attempted to C<use builtin :ver> for a version number that is either
+older than 5.39 (when the ability was added), or newer than the current perl
+version.
+
 =item Callback called exit
 
 (F) A subroutine invoked from an external package via call_sv()
@@ -3367,6 +3373,14 @@ See L<perlfunc/pack>.
 (W) The given character is not a valid pack or unpack type but used to be
 silently ignored.
 
+=item Invalid version bundle %s
+
+(F) A version number that is used to specify an import bundle during a
+C<use builtin ...> statement must be formatted as C<:MAJOR.MINOR> with an
+optional third component, which is ignored.  Each component must be a number
+of 1 to 3 digits. No other characters are permitted.  The value that was
+specified does not conform to these rules.
+
 =item Invalid version format (%s)
 
 (F) A version number did not meet the "lax" criteria for versions.