diff --git a/builtin.c b/builtin.c index 0d64a343efea..94c35b3a4440 100644 --- a/builtin.c +++ b/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(); diff --git a/lib/builtin.pm b/lib/builtin.pm index 83b6cc24d8e6..cf40e2a55179 100644 --- a/lib/builtin.pm +++ b/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 package. These are @@ -85,6 +87,23 @@ Imported symbols can also be removed again by using the C 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 diff --git a/lib/builtin.t b/lib/builtin.t index fefe78c402af..a8bf4ba92eed 100644 --- a/lib/builtin.t +++ b/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(); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 973cea2ab0b5..b9f4695d30d6 100644 --- a/pod/perldiag.pod +++ b/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 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. (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 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.