Until now, only overridable keywords had subs in the CORE:: namespace.
This branch adds subs to the CORE:: namespace for those non-overrida-
ble keywords that can be implemented without custom parsers.
assert(gv || stash);
assert(name);
- if (code >= 0) return NULL; /* not overridable */
- switch (-code) {
+ if (!code) return NULL; /* Not a keyword */
+ switch (code < 0 ? -code : code) {
/* no support for \&CORE::infix;
- no support for funcs that take labels, as their parsing is
- weird */
- case KEY_and: case KEY_cmp: case KEY_CORE: case KEY_dump:
- case KEY_eq: case KEY_ge:
- case KEY_gt: case KEY_le: case KEY_lt: case KEY_ne:
- case KEY_or: case KEY_x: case KEY_xor:
+ no support for funcs that do not parse like funcs */
+ case KEY___DATA__: case KEY___END__: case KEY_and: case KEY_AUTOLOAD:
+ case KEY_BEGIN : case KEY_CHECK : case KEY_cmp: case KEY_CORE :
+ case KEY_default : case KEY_DESTROY:
+ case KEY_do : case KEY_dump : case KEY_else : case KEY_elsif :
+ case KEY_END : case KEY_eq : case KEY_eval :
+ case KEY_for : case KEY_foreach: case KEY_format: case KEY_ge :
+ case KEY_given : case KEY_goto : case KEY_grep :
+ case KEY_gt : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le:
+ case KEY_local: case KEY_lt: case KEY_m : case KEY_map : case KEY_my:
+ case KEY_ne : case KEY_next : case KEY_no: case KEY_or: case KEY_our:
+ case KEY_package: case KEY_print: case KEY_printf:
+ case KEY_q : case KEY_qq : case KEY_qr : case KEY_qw :
+ case KEY_qx : case KEY_redo : case KEY_require: case KEY_return:
+ case KEY_s : case KEY_say : case KEY_sort :
+ case KEY_state: case KEY_sub :
+ case KEY_tr : case KEY_UNITCHECK: case KEY_unless:
+ case KEY_until: case KEY_use : case KEY_when : case KEY_while :
+ case KEY_x : case KEY_xor : case KEY_y :
return NULL;
case KEY_chdir:
- case KEY_chomp: case KEY_chop:
- case KEY_each: case KEY_eof: case KEY_exec:
+ case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete:
+ case KEY_each : case KEY_eof : case KEY_exec : case KEY_exists:
case KEY_keys:
case KEY_lstat:
case KEY_pop:
case KEY_push:
case KEY_shift:
- case KEY_splice:
+ case KEY_splice: case KEY_split:
case KEY_stat:
case KEY_system:
case KEY_truncate: case KEY_unlink:
1
);
assert(GvCV(gv) == cv);
- if (opnum != OP_VEC && opnum != OP_SUBSTR)
+ if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
+ && opnum != OP_UNDEF)
CvLVALUE_off(cv); /* Now *that* was a neat trick. */
LEAVE;
PL_parser = oldparser;
feature is new in Perl 5.16. You can take references to these and make
aliases. However, some can only be called as barewords; i.e., you cannot
use ampersand syntax (C<&foo>) or call them through references. See the
-C<shove> example above. These subroutines exist for all overridable
-keywords, except for C<dump> and the infix operators. Calling with
+C<shove> example above. These subroutines exist for all keywords except the following:
+
+C<__DATA__>, C<__END__>, C<and>, C<cmp>, C<default>, C<do>, C<dump>,
+C<else>, C<elsif>, C<eq>, C<eval>, C<for>, C<foreach>, C<format>, C<ge>,
+C<given>, C<goto>, C<grep>, C<gt>, C<if>, C<last>, C<le>, C<local>, C<lt>,
+C<m>, C<map>, C<my>, C<ne>, C<next>, C<no>, C<or>, C<our>, C<package>,
+C<print>, C<printf>, C<q>, C<qq>, C<qr>, C<qw>, C<qx>, C<redo>, C<require>,
+C<return>, C<s>, C<say>, C<sort>, C<state>, C<sub>, C<tr>, C<unless>,
+C<until>, C<use>, C<when>, C<while>, C<x>, C<xor>, C<y>
+
+Calling with
ampersand syntax and through references does not work for the following
functions, as they have special syntax that cannot always be translated
into a simple list (e.g., C<eof> vs C<eof()>):
-C<chdir>, C<chomp>, C<chop>, C<each>, C<eof>, C<exec>, C<keys>, C<lstat>,
-C<pop>, C<push>, C<shift>, C<splice>, C<stat>, C<system>, C<truncate>,
+C<chdir>, C<chomp>, C<chop>, C<defined>, C<delete>, C<each>,
+C<eof>, C<exec>, C<exists>, C<keys>, C<lstat>, C<pop>, C<push>,
+C<shift>, C<splice>, C<split>, C<stat>, C<system>, C<truncate>,
C<unlink>, C<unshift>, C<values>
=head1 OVERRIDING CORE FUNCTIONS
if (type != OP_LEAVESUBLV)
goto nomod;
break; /* op_lvalue()ing was handled by ck_return() */
+
+ case OP_COREARGS:
+ return o;
}
/* [20011101.069] File test operators interpret OPf_REF to mean that
switch (type) {
case OP_POS:
case OP_SASSIGN:
- assert(o);
- if (o->op_type == OP_RV2GV)
+ if (o && o->op_type == OP_RV2GV)
return FALSE;
/* FALL THROUGH */
case OP_PREINC:
scalar(kid);
break;
case OA_SCALARREF:
+ if ((type == OP_UNDEF || type == OP_POS)
+ && numargs == 1 && !(oa >> 4)
+ && kid->op_type == OP_LIST)
+ return too_many_arguments_pv(o,PL_op_desc[type], 0);
op_lvalue(scalar(kid), type);
break;
}
This function assigns the prototype of the named core function to C<sv>, or
to a new mortal SV if C<sv> is NULL. It returns the modified C<sv>, or
NULL if the core function has no prototype. C<code> is a code as returned
-by C<keyword()>. It must be negative and unequal to -KEY_CORE.
+by C<keyword()>. It must not be equal to 0 or -KEY_CORE.
=cut
*/
PERL_ARGS_ASSERT_CORE_PROTOTYPE;
- assert (code < 0 && code != -KEY_CORE);
+ assert (code && code != -KEY_CORE);
if (!sv) sv = sv_newmortal();
#define retsetpvs(x,y) sv_setpvs(sv, x); if(opnum) *opnum=(y); return sv
- switch (-code) {
+ switch (code < 0 ? -code : code) {
case KEY_and : case KEY_chop: case KEY_chomp:
- case KEY_cmp : case KEY_exec: case KEY_eq :
- case KEY_ge : case KEY_gt : case KEY_le :
- case KEY_lt : case KEY_ne : case KEY_or :
- case KEY_select: case KEY_system: case KEY_x : case KEY_xor:
+ case KEY_cmp : case KEY_defined: case KEY_delete: case KEY_exec :
+ case KEY_exists: case KEY_eq : case KEY_ge : case KEY_goto :
+ case KEY_grep : case KEY_gt : case KEY_last : case KEY_le :
+ case KEY_lt : case KEY_map : case KEY_ne : case KEY_next :
+ case KEY_or : case KEY_print : case KEY_printf: case KEY_qr :
+ case KEY_redo : case KEY_require: case KEY_return: case KEY_say :
+ case KEY_select: case KEY_sort : case KEY_split : case KEY_system:
+ case KEY_x : case KEY_xor :
if (!opnum) return NULL; nullret = TRUE; goto findopnum;
+ case KEY_glob: retsetpvs("_;", OP_GLOB);
case KEY_keys: retsetpvs("+", OP_KEYS);
case KEY_values: retsetpvs("+", OP_VALUES);
case KEY_each: retsetpvs("+", OP_EACH);
case KEY_unshift: retsetpvs("+@", OP_UNSHIFT);
case KEY_pop: retsetpvs(";+", OP_POP);
case KEY_shift: retsetpvs(";+", OP_SHIFT);
+ case KEY_pos: retsetpvs(";\\[$*]", OP_POS);
case KEY_splice:
retsetpvs("+;$$@", OP_SPLICE);
case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
}
i++;
}
- assert(0); return NULL; /* Should not happen... */
+ return NULL;
found:
defgv = PL_opargs[i] & OA_DEFGV;
oa = PL_opargs[i] >> OASHIFT;
str[n++] = '$';
str[n++] = '@';
str[n++] = '%';
- if (i == OP_LOCK) str[n++] = '&';
+ if (i == OP_LOCK || i == OP_UNDEF) str[n++] = '&';
str[n++] = '*';
str[n++] = ']';
}
onearg:
if (is_handle_constructor(o, 1))
argop->op_private |= OPpCOREARGS_DEREF1;
+ if (scalar_mod_type(NULL, opnum))
+ argop->op_private |= OPpCOREARGS_SCALARMOD;
}
return o;
default:
- o = convert(opnum,0,argop);
+ o = convert(opnum,OPf_SPECIAL*(opnum == OP_GLOB),argop);
if (is_handle_constructor(o, 2))
argop->op_private |= OPpCOREARGS_DEREF2;
- if (scalar_mod_type(NULL, opnum))
- argop->op_private |= OPpCOREARGS_SCALARMOD;
if (opnum == OP_SUBSTR) {
o->op_private |= OPpMAYBE_LVSUB;
return o;
Perl_ck_spair, /* chomp */
Perl_ck_null, /* schomp */
Perl_ck_defined, /* defined */
- Perl_ck_lfun, /* undef */
+ Perl_ck_fun, /* undef */
Perl_ck_fun, /* study */
- Perl_ck_lfun, /* pos */
+ Perl_ck_fun, /* pos */
Perl_ck_lfun, /* preinc */
Perl_ck_lfun, /* i_preinc */
Perl_ck_lfun, /* predec */
0x00002b1d, /* chomp */
0x00009b9c, /* schomp */
0x00009b84, /* defined */
- 0x00009b04, /* undef */
+ 0x0000fb04, /* undef */
0x00009b84, /* study */
- 0x00009b8c, /* pos */
+ 0x0000fb8c, /* pos */
0x00001164, /* preinc */
0x00001144, /* i_preinc */
0x00001164, /* predec */
the function whose prototype you want to retrieve.
If FUNCTION is a string starting with C<CORE::>, the rest is taken as a
-name for a Perl builtin. If the builtin is not I<overridable> (such as
-C<qw//>) or if its arguments cannot be adequately expressed by a prototype
+name for a Perl builtin. If the builtin's arguments
+cannot be adequately expressed by a prototype
(such as C<system>), prototype() returns C<undef>, because the builtin
does not really behave like a Perl function. Otherwise, the string
describing the equivalent prototype is returned.
const int code = keyword(s + 6, SvCUR(TOPs) - 6, 1);
if (!code || code == -KEY_CORE)
DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
- if (code < 0) { /* Overridable. */
+ {
SV * const sv = core_prototype(NULL, s + 6, code, NULL);
if (sv) ret = sv;
}
{
dSP;
int opnum = SvIOK(cSVOP_sv) ? (int)SvUV(cSVOP_sv) : 0;
- int defgv = PL_opargs[opnum] & OA_DEFGV, whicharg = 0;
+ int defgv = PL_opargs[opnum] & OA_DEFGV ||opnum==OP_GLOB, whicharg = 0;
AV * const at_ = GvAV(PL_defgv);
SV **svp = at_ ? AvARRAY(at_) : NULL;
I32 minargs = 0, maxargs = 0, numargs = at_ ? AvFILLp(at_)+1 : 0;
/* diag_listed_as: Too many arguments for %s */
Perl_croak(aTHX_
"%s arguments for %s", err,
- opnum ? OP_DESC(PL_op->op_next) : SvPV_nolen_const(cSVOP_sv)
+ opnum ? PL_op_desc[opnum] : SvPV_nolen_const(cSVOP_sv)
);
/* Reset the stack pointer. Without this, we end up returning our own
whicharg++;
switch (oa & 7) {
case OA_SCALAR:
+ try_defsv:
if (!numargs && defgv && whicharg == minargs + 1) {
PERL_SI * const oldsi = PL_curstackinfo;
I32 const oldcxix = oldsi->si_cxix;
}
break;
case OA_SCALARREF:
- {
+ if (!numargs) goto try_defsv;
+ else {
const bool wantscalar =
PL_op->op_private & OPpCOREARGS_SCALARMOD;
if (!svp || !*svp || !SvROK(*svp)
type permits the latter. */
|| SvTYPE(SvRV(*svp)) > (
wantscalar ? SVt_PVLV
- : opnum == OP_LOCK ? SVt_PVCV
+ : opnum == OP_LOCK || opnum == OP_UNDEF
+ ? SVt_PVCV
: SVt_PVHV
)
)
DIE(aTHX_
/* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/
"Type of arg %d to &CORE::%s must be %s",
- whicharg, OP_DESC(PL_op->op_next),
+ whicharg, PL_op_name[opnum],
wantscalar
? "scalar reference"
- : opnum == OP_LOCK
+ : opnum == OP_LOCK || opnum == OP_UNDEF
? "reference to one of [$@%&*]"
: "reference to one of [$@%*]"
);
PUSHs(SvRV(*svp));
- break;
+ if (opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv
+ && cxstack[cxstack_ix].cx_type & CXp_HASARGS) {
+ /* Undo @_ localisation, so that sub exit does not undo
+ part of our undeffing. */
+ PERL_CONTEXT *cx = &cxstack[cxstack_ix];
+ POP_SAVEARRAY();
+ cx->cx_type &= ~ CXp_HASARGS;
+ assert(!AvREAL(cx->blk_sub.argarray));
+ }
}
+ break;
default:
DIE(aTHX_ "panic: unknown OA_*: %x", (unsigned)(oa&7));
}
chomp chomp ck_spair mTs% L
schomp scalar chomp ck_null sTu% S?
defined defined operator ck_defined isu% S?
-undef undef operator ck_lfun s% S?
+undef undef operator ck_fun s% R?
study study ck_fun su% S?
-pos match position ck_lfun stu% S?
+pos match position ck_fun stu% R?
preinc preincrement (++) ck_lfun dIs1 S
i_preinc integer preincrement (++) ck_lfun dis1 S
@INC = '../lib';
}
-print "1..14\n";
+print "1..15\n";
my $i = 1;
test_too_many($_) for split /\n/,
q[ defined(&foo, $bar);
+ pos(1,$b);
undef(&foo, $bar);
uc($bar,$bar);
];
my %op_desc = (
evalbytes=> 'eval "string"',
join => 'join or string',
+ pos => 'match position',
+ prototype=> 'subroutine prototype',
readline => '<HANDLE>',
readpipe => 'quoted execution (``, qx)',
reset => 'symbol reset',
ref => 'reference-type operator',
+ undef => 'undef operator',
);
sub op_desc($) {
return $op_desc{$_[0]} || $_[0];
like $@, qr/^Too many arguments for $o at /, "&$o with too many args";
}
- elsif ($p eq '_') {
+ elsif ($p =~ /^_;?\z/) {
$tests ++;
eval " &CORE::$o(1,2) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be hash reference at /,
"&$o with non-hash arg with hash overload (which does not count)";
}
- elsif ($p =~ /^\\\[(\$\@%&?\*)](\$\@)?\z/) {
- $tests += 4;
+ elsif ($p =~ /^(;)?\\\[(\$\@%&?\*)](\$\@)?\z/) {
+ $tests += 3;
- unless ($2) {
+ unless ($3) {
$tests ++;
eval " &CORE::$o(1,2) ";
- like $@, qr/^Too many arguments for $o at /,
+ like $@, qr/^Too many arguments for ${\op_desc($o)} at /,
"&$o with too many args";
}
- eval { &{"CORE::$o"}($2 ? 1 : ()) };
- like $@, qr/^Not enough arguments for $o at /,
+ unless ($1) {
+ $tests ++;
+ eval { &{"CORE::$o"}($3 ? 1 : ()) };
+ like $@, qr/^Not enough arguments for $o at /,
"&$o with too few args";
- my $more_args = $2 ? ',1' : '';
+ }
+ my $more_args = $3 ? ',1' : '';
eval " &CORE::$o(2$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
- ) \[\Q$1\E] at /,
+ ) \[\Q$2\E] at /,
"&$o with non-ref arg";
eval " &CORE::$o(*STDOUT{IO}$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
- ) \[\Q$1\E] at /,
+ ) \[\Q$2\E] at /,
"&$o with ioref arg";
my $class = ref *DATA{IO};
eval " &CORE::$o(bless(*DATA{IO}, 'hov')$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x:
- ) \[\Q$1\E] at /,
+ ) \[\Q$2\E] at /,
"&$o with ioref arg with hash overload (which does not count)";
bless *DATA{IO}, $class;
- if (do {$1 !~ /&/}) {
+ if (do {$2 !~ /&/}) {
$tests++;
eval " &CORE::$o(\\&scriggle$more_args) ";
like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one (?x:
- )of \[\Q$1\E] at /,
+ )of \[\Q$2\E] at /,
"&$o with coderef arg";
}
}
+ elsif ($p eq ';\[$*]') {
+ $tests += 4;
+
+ my $desc = quotemeta op_desc($o);
+ eval " &CORE::$o(1,2) ";
+ like $@, qr/^Too many arguments for $desc at /,
+ "&$o with too many args";
+ eval " &CORE::$o([]) ";
+ like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+ "&$o with array ref arg";
+ eval " &CORE::$o(1) ";
+ like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+ "&$o with scalar arg";
+ eval " &CORE::$o(bless([], 'sov')) ";
+ like $@, qr/^Type of arg 1 to &CORE::$o must be scalar reference at /,
+ "&$o with non-scalar arg w/scalar overload (which does not count)";
+ }
else {
die "Please add tests for the $p prototype";
pwent pwnam pwuid servbyname servbyport servent sockname sockopt
';
+# Make sure the following tests test what we think they are testing.
+ok ! $CORE::{glob}, '*CORE::glob not autovivified yet'; $tests ++;
+{
+ # Make sure ck_glob does not respect the override when &CORE::glob is
+ # autovivified (by test_proto).
+ local *CORE::GLOBAL::glob = sub {};
+ test_proto 'glob';
+}
+$_ = "t/*.t";
+@_ = &myglob($_);
+is join($", &myglob()), "@_", '&glob without arguments';
+is join($", &myglob("t/*.t")), "@_", '&glob with an arg';
+$tests += 2;
+
test_proto 'gmtime';
&CORE::gmtime;
pass '&gmtime without args does not crash'; ++$tests;
lis [&mypack("H*", '5065726c')], ['Perl'], '&pack in list context';
test_proto 'pipe';
+
+test_proto 'pos';
+$tests += 4;
+$_ = "hello";
+pos = 3;
+is &mypos, 3, 'reading &pos without args';
+&mypos = 4;
+is pos, 4, 'writing to &pos without args';
+{
+ my $x = "gubai";
+ pos $x = 3;
+ is &mypos(\$x), 3, 'reading &pos without args';
+ &mypos(\$x) = 4;
+ is pos $x, 4, 'writing to &pos without args';
+}
+
+test_proto 'prototype';
+$tests++;
+is &myprototype(\&myprototype), prototype("CORE::prototype"), '&prototype';
+
test_proto 'quotemeta', '$', '\$';
test_proto 'rand';
test_proto 'rmdir';
+test_proto 'scalar';
+$tests += 2;
+is &myscalar(3), 3, '&scalar';
+lis [&myscalar(3)], [3], '&scalar in list cx';
+
test_proto 'seek';
{
last if is_miniperl;
&CORE::srand;
pass '&srand with no args does not crash';
+test_proto 'study';
+
test_proto 'substr';
$tests += 5;
$_ = "abc";
$tests ++;
is &myumask, umask, '&umask with no args';
+test_proto 'undef';
+$tests += 12;
+is &myundef(), undef, '&undef returns undef';
+lis [&myundef()], [undef], '&undef returns undef in list cx';
+lis [&myundef(\$_)], [undef], '&undef(...) returns undef in list cx';
+is \&myundef(), \undef, '&undef returns the right undef';
+$_ = 'anserine questions';
+&myundef(\$_);
+is $_, undef, '&undef(\$_) undefines $_';
+@_ = 1..3;
+&myundef(\@_);
+is @_, 0, '&undef(\@_) undefines @_';
+%_ = 1..4;
+&myundef(\%_);
+ok !%_, '&undef(\%_) undefines %_';
+&myundef(\&utf8::valid); # nobody should be using this :-)
+ok !defined &utf8::valid, '&undef(\&foo) undefines &foo';
+@_ = \*_;
+&myundef;
+is *_{ARRAY}, undef, '@_=\*_, &undef undefines *_';
+@_ = \*_;
+&myundef(\*_);
+is *_{ARRAY}, undef, '&undef(\*_) undefines *_';
+(&myundef(), @_) = 1..10;
+lis \@_, [2..10], 'list assignment to &undef()';
+ok !defined undef, 'list assignment to &undef() does not affect undef';
+undef @_;
+
test_proto 'unpack';
$tests += 2;
$_ = 'abcd';
open my $kh, $keywords_file
or die "$0 cannot open $keywords_file: $!";
while(<$kh>) {
- if (m?__END__?..${\0} and /^[-](.*)/) {
+ if (m?__END__?..${\0} and /^[-+](.*)/) {
my $word = $1;
next if
- $word =~ /^(?:CORE|and|cmp|dump|eq|ge|gt|le|lt|ne|or|x|xor)\z/;
+ $word =~ /^(?:s(?:tate|ort|ay|ub)?|d(?:ef
+ ault|ump|o)|p(?:rintf?|ackag
+ e)|e(?:ls(?:if|e)|val|q)|g(?:[et]|iven|oto
+ |rep)|u(?:n(?:less|til)|se)|l(?:(?:as)?t|ocal|e)|re
+ (?:quire|turn|do)|__(?:DATA|END)__|for(?:each|mat)?|(?:
+ AUTOLOA|EN)D|n(?:e(?:xt)?|o)|C(?:HECK|ORE)|wh(?:ile|en)
+ |(?:ou?|t)r|m(?:ap|y)?|UNITCHECK|q[qrwx]?|x(?:or)?|DEST
+ ROY|BEGIN|INIT|and|cmp|if|y)\z/x;
$tests ++;
ok exists &{"my$word"}
|| (eval{&{"CORE::$word"}}, $@ =~ /cannot be called directly/),
use B::Deparse;
my $bd = new B::Deparse '-p';
-my %unsupported = map +($_=>1), qw (CORE and cmp dump eq ge gt le
- lt ne or x xor);
+my %unsupported = map +($_=>1), qw (
+ __DATA__ __END__ AUTOLOAD BEGIN UNITCHECK CORE DESTROY END INIT CHECK and
+ cmp default do dump else elsif eq eval for foreach
+ format ge given goto grep gt if last le local lt m map my ne next
+ no or our package print printf q qq qr qw qx redo require
+ return s say sort state sub tr unless until use
+ when while x xor y
+);
my %args_for = (
dbmopen => '%1,$2,$3',
dbmclose => '%1',
+ delete => '$1[2]',
+ exists => '$1[2]',
+);
+my %desc = (
+ pos => 'match position',
);
use File::Spec::Functions;
while(<$kh>) {
if (m?__END__?..${\0} and /^[+-]/) {
chomp(my $word = $');
- if($& eq '+' || $unsupported{$word}) {
+ if($unsupported{$word}) {
$tests ++;
ok !defined &{"CORE::$word"}, "no CORE::$word";
}
CORE::state $protochar = qr/([^\\]|\\(?:[^[]|\[[^]]+\]))/;
my $numargs =
- () = $proto =~ s/;.*//r =~ /\G$protochar/g;
+ $word eq 'delete' || $word eq 'exists' ? 1 :
+ (() = $proto =~ s/;.*//r =~ /\G$protochar/g);
my $code =
"#line 1 This-line-makes-__FILE__-easier-to-test.
sub { () = (my$word("
next if ($proto =~ /\@/);
# These ops currently accept any number of args, despite their
# prototypes, if they have any:
- next if $word =~ /^(?:chom?p|exec|keys|each|not|read(?:lin|pip)e
+ next if $word =~ /^(?:chom?p|exec|keys|each|not
+ |(?:prototyp|read(?:lin|pip))e
|reset|system|values|l?stat)|evalbytes/x;
$tests ++;
)
. "))}";
eval $code;
- like $@, qr/^Too many arguments for $word/,
+ my $desc = $desc{$word} || $word;
+ like $@, qr/^Too many arguments for $desc/,
"inlined CORE::$word with too many args"
or warn $code;
getsockname (*)
getsockopt (*$$)
given undef
-glob undef
+glob (_;)
gmtime (;$)
goto undef
grep undef
package undef
pipe (**)
pop (;+)
-pos undef
+pos (;\[$*])
print undef
printf undef
-prototype undef
+prototype ($)
push (+@)
q undef
qq undef
rmdir (_)
s undef
say undef
-scalar undef
+scalar ($)
seek (*$$)
seekdir (*$)
select undef
srand (;$)
stat (;*)
state undef
-study undef
+study (_)
sub undef
substr ($$;$$)
symlink ($$)
uc (_)
ucfirst (_)
umask (;$)
-undef undef
+undef (;\[$@%&*])
unless undef
unlink (@)
unpack ($_)
https://perl5.git.perl.org / perl5.git / commitdiff