Add builtin function export_lexically()

As per RFC 0020

builtin.c

@@ -263,6 +263,79 @@ XS(XS_builtin_trim)
     XSRETURN(1);
 }
 
+XS(XS_builtin_export_lexically);
+XS(XS_builtin_export_lexically)
+{
+    dXSARGS;
+
+    warn_experimental_builtin("export_lexically", true);
+
+    if(!PL_compcv)
+        Perl_croak(aTHX_
+                "export_lexically can only be called at compile time");
+
+    if(items % 2)
+        Perl_croak(aTHX_ "Odd number of elements in export_lexically");
+
+    for(int i = 0; i < items; i += 2) {
+        SV *name = ST(i);
+        SV *ref  = ST(i+1);
+
+        if(!SvROK(ref))
+            /* diag_listed_as: Expected %s reference in export_lexically */
+            Perl_croak(aTHX_ "Expected a reference in export_lexically");
+
+        char sigil = SvPVX(name)[0];
+        SV *rv = SvRV(ref);
+
+        const char *bad = NULL;
+        switch(sigil) {
+            default:
+                /* overwrites the pointer on the stack; but this is fine, the
+                 * caller's value isn't modified */
+                ST(i) = name = sv_2mortal(Perl_newSVpvf(aTHX_ "&%" SVf, SVfARG(name)));
+
+                /* FALLTHROUGH */
+            case '&':
+                if(SvTYPE(rv) != SVt_PVCV)
+                    bad = "a CODE";
+                break;
+
+            case '$':
+                /* Permit any of SVt_NULL to SVt_PVMG. Technically this also
+                 * includes SVt_INVLIST but it isn't thought possible for pureperl
+                 * code to ever manage to see one of those. */
+                if(SvTYPE(rv) > SVt_PVMG)
+                    bad = "a SCALAR";
+                break;
+
+            case '@':
+                if(SvTYPE(rv) != SVt_PVAV)
+                    bad = "an ARRAY";
+                break;
+
+            case '%':
+                if(SvTYPE(rv) != SVt_PVHV)
+                    bad = "a HASH";
+                break;
+        }
+
+        if(bad)
+            Perl_croak(aTHX_ "Expected %s reference in export_lexically", bad);
+    }
+
+    prepare_export_lexical();
+
+    for(int i = 0; i < items; i += 2) {
+        SV *name = ST(i);
+        SV *ref  = ST(i+1);
+
+        export_lexical(name, SvRV(ref));
+    }
+
+    finish_export_lexical();
+}
+
 XS(XS_builtin_func1_void);
 XS(XS_builtin_func1_void)
 {
@@ -433,6 +506,7 @@ static const struct BuiltinFuncDescriptor builtins[] = {
 
     /* list functions */
     { "builtin::indexed", &XS_builtin_indexed, &ck_builtin_funcN, 0 },
+    { "builtin::export_lexically", &XS_builtin_export_lexically, NULL, 0 },
     { 0 }
 };
 

lib/builtin.pm

@@ -25,6 +25,7 @@ builtin - Perl pragma to import built-in utility functions
         indexed
         trim
         is_tainted
+        export_lexically
     );
 
 =head1 DESCRIPTION
@@ -288,6 +289,35 @@ L<String::Util> module for a comparable implementation.
 
 Returns true when given a tainted variable.
 
+=head2 export_lexically
+
+    export_lexically($name1, $ref1, $name2, $ref2, ...)
+
+Exports new lexical names into the scope currently being compiled. Names given
+by the first of each pair of values will refer to the corresponding item whose
+reference is given by the second. Types of item that are permitted are
+subroutines, and scalar, array, and hash variables. If the item is a
+subroutine, the name may optionally be prefixed with the C<&> sigil, but for
+convenience it doesn't have to. For items that are variables the sigil is
+required, and must match the type of the variable.
+
+    export_lexically func    => \&func,
+                     '&func' => \&func;  # same as above
+
+    export_lexically '$scalar' => \my $var;
+
+Z<>
+
+    # The following are not permitted
+    export_lexically '$var' => \@arr;   # sigil does not match
+    export_lexically name => \$scalar;  # implied '&' sigil does not match
+
+    export_lexically '*name' => \*globref;  # globrefs are not supported
+
+This must be called at compile time; which typically means during a C<BEGIN>
+block. Usually this would be used as part of an C<import> method of a module,
+when invoked as part of a C<use ...> statement.
+
 =head1 SEE ALSO
 
 L<perlop>, L<perlfunc>, L<Scalar::Util>

lib/builtin.t

@@ -358,6 +358,41 @@ TODO: {
     is($storecount, 1, 'is_tainted() invokes STORE magic');
 }
 
+# Lexical export
+{
+    my $name;
+    BEGIN {
+        use builtin qw( export_lexically );
+
+        $name = "message";
+        export_lexically $name => sub { "Hello, world" };
+    }
+
+    is(message(), "Hello, world", 'Lexically exported sub is callable');
+    ok(!__PACKAGE__->can("message"), 'Exported sub is not visible via ->can');
+
+    is($name, "message", '$name argument was not modified by export_lexically');
+
+    our ( $scalar, @array, %hash );
+    BEGIN {
+        use builtin qw( export_lexically );
+
+        export_lexically
+            '$SCALAR' => \$scalar,
+            '@ARRAY'  => \@array,
+            '%HASH'   => \%hash;
+    }
+
+    $::scalar = "value";
+    is($SCALAR, "value", 'Lexically exported scalar is accessible');
+
+    @::array = ('a' .. 'e');
+    is(scalar @ARRAY, 5, 'Lexically exported array is accessible');
+
+    %::hash = (key => "val");
+    is($HASH{key}, "val", 'Lexically exported hash is accessible');
+}
+
 # vim: tabstop=4 shiftwidth=4 expandtab autoindent softtabstop=4
 
 done_testing();

pod/perldiag.pod

@@ -2275,6 +2275,12 @@ as a goto, or a loop control statement.
 (W exiting) You are exiting a substitution by unconventional means, such
 as a return, a goto, or a loop control statement.
 
+=item Expected %s reference in export_lexically
+
+(F) The type of a reference given to L<builtin/export_lexically> did not
+match the sigil of the preceding name, or the value was not a reference at
+all. 
+
 =item Expecting close bracket in regex; marked by S<<-- HERE> in m/%s/
 
 (F) You wrote something like
@@ -2327,6 +2333,12 @@ the effect of blessing the reference into the package main.  This is
 usually not what you want.  Consider providing a default target package,
 e.g. bless($ref, $p || 'MyPackage');
 
+=item export_lexically can only be called at compile time
+
+(F) L<builtin/export_lexically> was called at runtime.  Because it creates
+new names in the lexical scope currently being compiled, it can only be
+called from code inside C<BEGIN> block in that scope.
+
 =item %s: Expression syntax
 
 (A) You've accidentally run your script through B<csh> instead of Perl.
@@ -4458,6 +4470,12 @@ arguments.  The arguments should come in pairs.
 (W misc) You specified an odd number of elements to initialize a hash,
 which is odd, because hashes come in key/value pairs.
 
+=item Odd number of elements in export_lexically
+
+(F) A call to L<builtin/export_lexically> contained an odd number of
+arguments.  This is not permitted, because each name must be paired with a
+valid reference value.
+
 =item Odd number of elements in hash assignment
 
 (W misc) You specified an odd number of elements to initialize a hash,