Add builtin function lexically_export()

builtin.c

@@ -259,6 +259,79 @@ XS(XS_builtin_trim)
     XSRETURN(1);
 }
 
+XS(XS_builtin_lexically_export);
+XS(XS_builtin_lexically_export)
+{
+    dXSARGS;
+
+    warn_experimental_builtin("lexically_export", true);
+
+    if(!PL_compcv)
+        Perl_croak(aTHX_
+                "lexically_export can only be called at compile time");
+
+    if(items % 2)
+        Perl_croak(aTHX_ "Odd number of elements in lexically_export");
+
+    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 lexically_export */
+            Perl_croak(aTHX_ "Expected a reference in lexically_export");
+
+        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 lexically_export", bad);
+    }
+
+    prepare_lexical_export();
+
+    for(int i = 0; i < items; i += 2) {
+        SV *name = ST(i);
+        SV *ref  = ST(i+1);
+
+        lexically_export(name, SvRV(ref));
+    }
+
+    finish_lexical_export();
+}
+
 XS(XS_builtin_func1_void);
 XS(XS_builtin_func1_void)
 {
@@ -426,6 +499,9 @@ static const struct BuiltinFuncDescriptor builtins[] = {
     { "builtin::created_as_string", &XS_builtin_created_as_string, &ck_builtin_func1, 0 },
     { "builtin::created_as_number", &XS_builtin_created_as_number, &ck_builtin_func1, 0 },
 
+    /* binary functions */
+    { "builtin::lexically_export", &XS_builtin_lexically_export, NULL, 0 },
+
     /* list functions */
     { "builtin::indexed", &XS_builtin_indexed, &ck_builtin_funcN, 0 },
     { 0 }

lib/builtin.pm

@@ -1,4 +1,4 @@
-package builtin 0.007;
+package builtin 0.008;
 
 use strict;
 use warnings;
@@ -24,6 +24,7 @@ builtin - Perl pragma to import built-in utility functions
         ceil floor
         indexed
         trim
+        lexically_export
     );
 
 =head1 DESCRIPTION
@@ -281,6 +282,35 @@ C<trim> is equivalent to:
 For Perl versions where this feature is not available look at the
 L<String::Util> module for a comparable implementation.
 
+=head2 lexically_export
+
+    lexically_export($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.
+
+    lexically_export func    => \&func,
+                     '&func' => \&func;  # same as above
+
+    lexically_export '$scalar' => \my $var;
+
+Z<>
+
+    # The following are not permitted
+    lexically_export '$var' => \@arr;   # sigil does not match
+    lexically_export name => \$scalar;  # implied '&' sigil does not match
+
+    lexically_export '*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

@@ -342,6 +342,41 @@ TODO: {
     is(trim($str2), "Hello world!", "Trim on an our \$var");
 }
 
+# Lexical export
+{
+    my $name;
+    BEGIN {
+        use builtin qw( lexically_export );
+
+        $name = "message";
+        lexically_export $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 lexically_export');
+
+    our ( $scalar, @array, %hash );
+    BEGIN {
+        use builtin qw( lexically_export );
+
+        lexically_export
+            '$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 lexically_export
+
+(F) The type of a reference given to L<builtin/lexically_export> 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
@@ -3345,6 +3351,12 @@ The number of items in a hash can be obtained by doing:
 
     scalar(keys %hash);
 
+=item lexically_export can only be called at compile time
+
+(F) L<builtin/lexically_export> 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 Lexing code attempted to stuff non-Latin-1 character into Latin-1 input
 
 (F) An extension is attempting to insert text into the current parse
@@ -4463,6 +4475,12 @@ which is odd, because hashes come in key/value 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 lexically_export
+
+(F) A call to L<builtin/lexically_export> contained an odd number of
+arguments.  This is not permitted, because each name must be paired with a
+valid reference value.
+
 =item Offset outside string
 
 (F)(W layer) You tried to do a read/write/send/recv/seek operation