In perl.git, the branch sprout/overridesβ has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a514ada2b2efe361b923b1dac7b3cccfc8128100?hp=6b5db91b44f251790ebf3d4984f2452b97b1d301>
- Log ----------------------------------------------------------------- commit a514ada2b2efe361b923b1dac7b3cccfc8128100 Author: Father Chrysostomos <[email protected]> Date: Thu Apr 26 20:40:48 2012 -0700 Add &CORE::delete M gv.c M t/op/coreamp.t M t/op/coresubs.t commit 7274479739a09b439448acf1c35ccfd6b5a44b8c Author: Father Chrysostomos <[email protected]> Date: Thu Apr 26 20:38:37 2012 -0700 Add &CORE::defined M gv.c M t/op/coreamp.t M t/op/coresubs.t commit b7a1e47812c200671f26b6e2b99e6a424662efc5 Author: Father Chrysostomos <[email protected]> Date: Thu Apr 26 20:36:03 2012 -0700 coresubs.t: Explicitly skip all unsupported keywords Instead of skipping positive keywords (those that cannot be over- ridden) because of their positivity, list them explicitly in the skip list. This will allow them to be removed one by one. M t/op/coresubs.t commit 5f050c618a786a2c237c793232f4783f94042071 Author: Father Chrysostomos <[email protected]> Date: Thu Apr 26 20:31:22 2012 -0700 coreamp.t: Explicitly skip all unsupported keywords Instead of skipping positive keywords (those that cannot be over- ridden) because of their positivity, list them explicitly in the skip list. This will allow them to be removed one by one. M t/op/coreamp.t commit 8e66bd9ffb8600187998074e70f9bb1b9438ca5c Author: Father Chrysostomos <[email protected]> Date: Thu Apr 26 20:09:14 2012 -0700 Removed prototypes from (un)def(ined) M op.c M t/op/cproto.t ----------------------------------------------------------------------- Summary of changes: gv.c | 8 +++----- op.c | 18 ++++++++---------- t/op/coreamp.t | 11 +++++++++-- t/op/coresubs.t | 22 +++++++++++++++------- t/op/cproto.t | 4 ++-- 5 files changed, 37 insertions(+), 26 deletions(-) diff --git a/gv.c b/gv.c index c647ac5..a6f7f33 100644 --- a/gv.c +++ b/gv.c @@ -455,12 +455,10 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, 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; - no support (yet) for keywords that are not overridable */ + 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_defined: case KEY_delete: case KEY_DESTROY: + 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_exists : case KEY_for : case KEY_foreach: case KEY_format: case KEY_ge : @@ -478,7 +476,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, case KEY_x : case KEY_xor : case KEY_y : return NULL; case KEY_chdir: - case KEY_chomp: case KEY_chop: + case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete: case KEY_each: case KEY_eof: case KEY_exec: case KEY_keys: case KEY_lstat: diff --git a/op.c b/op.c index 131b48b..281c443 100644 --- a/op.c +++ b/op.c @@ -10542,16 +10542,15 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, switch (code < 0 ? -code : code) { case KEY_and : case KEY_chop: case KEY_chomp: - case KEY_cmp : 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 : + 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_undef : case KEY_x : case KEY_xor : if (!opnum) return NULL; nullret = TRUE; goto findopnum; - case KEY_defined: retsetpvs(";\\[$@%&*]", OP_DEFINED); case KEY_glob: retsetpvs("_;", OP_GLOB); case KEY_keys: retsetpvs("+", OP_KEYS); case KEY_values: retsetpvs("+", OP_VALUES); @@ -10559,7 +10558,6 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, case KEY_push: retsetpvs("+@", OP_PUSH); case KEY_unshift: retsetpvs("+@", OP_UNSHIFT); case KEY_pop: retsetpvs(";+", OP_POP); - case KEY_undef: retsetpvs(";\\[$@%&*]", OP_UNDEF); case KEY_shift: retsetpvs(";+", OP_SHIFT); case KEY_splice: retsetpvs("+;$$@", OP_SPLICE); diff --git a/t/op/coreamp.t b/t/op/coreamp.t index 78ced66..25f5399 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -875,10 +875,17 @@ like $@, qr'^Undefined format "STDOUT" called', 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(?:t(?:ate|udy)|(?:pli|or)t|calar|ay|ub)?|d(?:ef + ault|ump|o)|p(?:r(?:ototype|intf?)|ackag + e|os)|e(?:ls(?:if|e)|xists|val|q)|g(?:[et]|iven|lob|oto + |rep)|u(?:n(?:less|def|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/), diff --git a/t/op/coresubs.t b/t/op/coresubs.t index b0263ee..c9c2fe3 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -15,8 +15,14 @@ BEGIN { 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 exists for foreach + format ge given glob goto grep gt if last le local lt m map my ne next + no or our package pos print printf prototype q qq qr qw qx redo require + return s say scalar sort split state study sub tr undef unless until use + when while x xor y +); my %args_for = ( dbmopen => '%1,$2,$3', dbmclose => '%1', @@ -29,7 +35,7 @@ open my $kh, $keywords_file 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"; } @@ -44,11 +50,13 @@ while(<$kh>) { CORE::state $protochar = qr/([^\\]|\\(?:[^[]|\[[^]]+\]))/; my $numargs = - () = $proto =~ s/;.*//r =~ /\G$protochar/g; + $word eq 'delete' ? 1 : + (() = $proto =~ s/;.*//r =~ /\G$protochar/g); + my $suf = $word eq 'delete' ? '[0]' : ''; my $code = "#line 1 This-line-makes-__FILE__-easier-to-test. sub { () = (my$word(" - . ($args_for{$word} || join ",", map "\$$_", 1..$numargs) + . ($args_for{$word} || join ",", map "\$$_$suf", 1..$numargs) . "))}"; my $core = $bd->coderef2text(eval $code =~ s/my/CORE::/r or die); my $my = $bd->coderef2text(eval $code or die); @@ -57,7 +65,7 @@ while(<$kh>) { $code = "#line 1 This-line-makes-__FILE__-easier-to-test. sub { () = (my$word " - . ($args_for{$word} || join ",", map "\$$_", 1..$numargs) + . ($args_for{$word} || join ",", map "\$$_$suf", 1..$numargs) . ")}"; $core = $bd->coderef2text(eval $code =~ s/my/CORE::/r or die); $my = $bd->coderef2text(eval $code or die); @@ -92,7 +100,7 @@ while(<$kh>) { . ( $args_for{$word} ? $args_for{$word}.',$7' - : join ",", map "\$$_", 1..$numargs+5+( + : join ",", map "\$$_$suf", 1..$numargs+5+( $proto =~ /;/ ? () = $' =~ /\G$protochar/g : 0 diff --git a/t/op/cproto.t b/t/op/cproto.t index 48f88eb..3623a45 100644 --- a/t/op/cproto.t +++ b/t/op/cproto.t @@ -70,7 +70,7 @@ crypt ($$) dbmclose (\%) dbmopen (\%$$) default undef -defined (;\[$@%&*]) +defined undef delete undef die (@) do undef @@ -263,7 +263,7 @@ truncate ($$) uc (_) ucfirst (_) umask (;$) -undef (;\[$@%&*]) +undef undef unless undef unlink (@) unpack ($_) -- Perl5 Master Repository
