Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Add a builtin:: namespace, with true/false/isbool
This finishes the perl-visible API required for RFC 0008 https://github.com/Perl/RFCs/blob/master/rfcs/rfc0008.md It also begins the "builtin::" namespace of RFC 0009 https://github.com/Perl/RFCs/blob/master/rfcs/rfc0009.md
- Loading branch information
Showing
15 changed files
with
322 additions
and
10 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,103 @@ | ||
| /* builtin.c | ||
| * | ||
| * Copyright (C) 2021 by Paul Evans and others | ||
| * | ||
| * You may distribute under the terms of either the GNU General Public | ||
| * License or the Artistic License, as specified in the README file. | ||
| * | ||
| */ | ||
|
|
||
| /* This file contains the code that implements functions in perl's "builtin::" | ||
| * namespace | ||
| */ | ||
|
|
||
| #include "EXTERN.h" | ||
| #include "perl.h" | ||
|
|
||
| #include "XSUB.h" | ||
|
|
||
| XS(XS_builtin_true); | ||
| XS(XS_builtin_true) | ||
| { | ||
| dXSARGS; | ||
| if(items) | ||
| croak_xs_usage(cv, ""); | ||
| XSRETURN_YES; | ||
| } | ||
|
|
||
| XS(XS_builtin_false); | ||
| XS(XS_builtin_false) | ||
| { | ||
| dXSARGS; | ||
| if(items) | ||
| croak_xs_usage(cv, ""); | ||
| XSRETURN_NO; | ||
| } | ||
|
|
||
| XS(XS_builtin_isbool); | ||
| XS(XS_builtin_isbool) | ||
| { | ||
| dXSARGS; | ||
| if(items != 1) | ||
| croak_xs_usage(cv, "sv"); | ||
|
|
||
| SV *sv = ST(0); | ||
| if(SvIsBOOL(sv)) | ||
| XSRETURN_YES; | ||
| else | ||
| XSRETURN_NO; | ||
| } | ||
|
|
||
| XS(XS_builtin_import); | ||
| XS(XS_builtin_import) | ||
| { | ||
| dXSARGS; | ||
|
|
||
| if(!PL_compcv) | ||
| Perl_croak(aTHX_ | ||
| "builtin::import can only be called at compiletime"); | ||
|
|
||
| /* We need to have PL_comppad / PL_curpad set correctly for lexical importing */ | ||
| ENTER; | ||
| SAVESPTR(PL_comppad_name); PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv)); | ||
| SAVESPTR(PL_comppad); PL_comppad = PadlistARRAY(CvPADLIST(PL_compcv))[1]; | ||
| SAVESPTR(PL_curpad); PL_curpad = PadARRAY(PL_comppad); | ||
|
|
||
| for(int i = 1; i < items; i++) { | ||
| SV *sym = ST(i); | ||
| if(strEQ(SvPV_nolen(sym), "import")) goto unavailable; | ||
|
|
||
| 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) goto unavailable; | ||
|
|
||
| PADOFFSET off = pad_add_name_sv(ampname, padadd_STATE, 0, 0); | ||
| SvREFCNT_dec(PL_curpad[off]); | ||
| PL_curpad[off] = SvREFCNT_inc(cv); | ||
| continue; | ||
|
|
||
| unavailable: | ||
| Perl_croak(aTHX_ | ||
| "'%" SVf "' is not recognised as a builtin function", sym); | ||
| } | ||
|
|
||
| intro_my(); | ||
|
|
||
| LEAVE; | ||
| } | ||
|
|
||
| void | ||
| Perl_boot_core_builtin(pTHX) | ||
| { | ||
| newXS_flags("builtin::true", &XS_builtin_true, __FILE__, NULL, 0); | ||
| newXS_flags("builtin::false", &XS_builtin_false, __FILE__, NULL, 0); | ||
| newXS_flags("builtin::isbool", &XS_builtin_isbool, __FILE__, NULL, 0); | ||
|
|
||
| newXS_flags("builtin::import", &XS_builtin_import, __FILE__, NULL, 0); | ||
| } | ||
|
|
||
| /* | ||
| * ex: set ts=8 sts=4 sw=4 et: | ||
| */ |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,102 @@ | ||
| package builtin 0.001; | ||
|
|
||
| use strict; | ||
| use warnings; | ||
|
|
||
| # All code, including &import, is implemented by always-present functions in | ||
| # the perl interpreter itself. | ||
| # See also `builtin.c` in perl source | ||
|
|
||
| 1; | ||
| __END__ | ||
| =head1 NAME | ||
| builtin - Perl pragma to import built-in utility functions | ||
| =head1 SYNOPSIS | ||
| use builtin qw( true false isbool ); | ||
| =head1 DESCRIPTION | ||
| Perl provides several utility functions in the C<builtin> package. These are | ||
| plain functions, and look and behave just like regular user-defined functions | ||
| do. They do not provide new syntax or require special parsing. These functions | ||
| are always present in the interpreter and can be called at any time by their | ||
| fully-qualified names. By default they are not available as short names, but | ||
| can be requested for convenience. | ||
| Individual named functions can be imported by listing them as import | ||
| parameters on the C<use> statement for this pragma. | ||
| =head2 Lexical Import | ||
| This pragma module creates I<lexical> aliases in the currently-compiling scope | ||
| to these builtin functions. This is similar to the lexical effect of other | ||
| pragmas such as L<strict> and L<feature>. | ||
| sub classify | ||
| { | ||
| my $sv = shift; | ||
| use builtin 'isbool'; | ||
| return isbool($sv) ? "boolean" : "not a boolean"; | ||
| } | ||
| # the isbool() function is no longer visible here | ||
| # but may still be called by builtin::isbool() | ||
| Because these functions are imported lexically, rather than by package | ||
| symbols, the user does not need to take any special measures to ensure they | ||
| don't accidentally appear as object methods from a class. | ||
| package An::Object::Class { | ||
| use builtin 'true', 'false'; | ||
| ... | ||
| } | ||
| # does not appear as a method | ||
| An::Object::Class->true; | ||
| # Can't locate object method "true" via package "An::Object::Class" | ||
| # at ... | ||
| =head1 FUNCTIONS | ||
| =head2 true | ||
| $val = true; | ||
| Returns the boolean truth value. While any scalar value can be tested for | ||
| truth and most defined, non-empty and non-zero values are considered "true" | ||
| by perl, this one is special in that L</isbool> considers it to be a | ||
| distinguished boolean value. | ||
| This gives an equivalent value to expressions like C<!!1> or C<!0>. | ||
| =head2 false | ||
| $val = false; | ||
| Returns the boolean fiction value. While any non-true scalar value is | ||
| considered "false" by perl, this one is special in that L</isbool> considers | ||
| it to be a distinguished boolean value. | ||
| This gives an equivalent value to expressions like C<!!0> or C<!1>. | ||
| =head2 isbool | ||
| $bool = isbool($val); | ||
| Returns true when given a distinguished boolean value, or false if not. A | ||
| distinguished boolean value is the result of any boolean-returning builtin | ||
| function (such as C<true> or C<isbool> itself), boolean-returning operator | ||
| (such as the C<eq> or C<==> comparison tests or the C<!> negation operator), | ||
| or any variable containing one of these results. | ||
| =head1 SEE ALSO | ||
| L<perlop>, L<perlfunc>, L<Scalar::Util> | ||
| =cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,78 @@ | ||
| #!./perl | ||
|
|
||
| BEGIN { | ||
| chdir 't' if -d 't'; | ||
| require './test.pl'; | ||
| set_up_inc('../lib'); | ||
| } | ||
|
|
||
| use strict; | ||
| use warnings; | ||
|
|
||
| # booleans | ||
| { | ||
| use builtin qw( true false isbool ); | ||
|
|
||
| ok(true, 'true is true'); | ||
| ok(!false, 'false is false'); | ||
|
|
||
| ok(isbool(true), 'true is bool'); | ||
| ok(isbool(false), 'false is bool'); | ||
| ok(!isbool(undef), 'undef is not bool'); | ||
| ok(!isbool(1), '1 is not bool'); | ||
| ok(!isbool(""), 'empty is not bool'); | ||
|
|
||
| my $truevar = (5 == 5); | ||
| my $falsevar = (5 == 6); | ||
|
|
||
| ok(isbool($truevar), '$truevar is bool'); | ||
| ok(isbool($falsevar), '$falsevar is bool'); | ||
|
|
||
| ok(isbool(isbool(true)), 'isbool true is bool'); | ||
| ok(isbool(isbool(123)), 'isbool false is bool'); | ||
| } | ||
|
|
||
| # imports are lexical; should not be visible here | ||
| { | ||
| my $ok = eval 'true()'; my $e = $@; | ||
| ok(!$ok, 'true() not visible outside of lexical scope'); | ||
| like($e, qr/^Undefined subroutine &main::true called at /, 'failure from true() not visible'); | ||
| } | ||
|
|
||
| # lexical imports work fine in a variety of situations | ||
| { | ||
| sub regularfunc { | ||
| use builtin 'true'; | ||
| return true; | ||
| } | ||
| ok(regularfunc(), 'true in regular sub'); | ||
|
|
||
| my sub lexicalfunc { | ||
| use builtin 'true'; | ||
| return true; | ||
| } | ||
| ok(lexicalfunc(), 'true in lexical sub'); | ||
|
|
||
| my $coderef = sub { | ||
| use builtin 'true'; | ||
| return true; | ||
| }; | ||
| ok($coderef->(), 'true in anon sub'); | ||
|
|
||
| sub recursefunc { | ||
| use builtin 'true'; | ||
| return recursefunc() if @_; | ||
| return true; | ||
| } | ||
| ok(recursefunc("rec"), 'true in self-recursive sub'); | ||
|
|
||
| my $recursecoderef = sub { | ||
| use feature 'current_sub'; | ||
| use builtin 'true'; | ||
| return __SUB__->() if @_; | ||
| return true; | ||
| }; | ||
| ok($recursecoderef->("rec"), 'true in self-recursive anon sub'); | ||
| } | ||
|
|
||
| done_testing(); |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.