Front page | perl.perl5.changes |
Postings from April 2012
[perl.git] branch sprout/overridesβ, updated. v5.15.9-269-ga514ada
From:
Father Chrysostomos
Date:
April 27, 2012 06:28
Subject:
[perl.git] branch sprout/overridesβ, updated. v5.15.9-269-ga514ada
Message ID:
E1SNlDN-0001Fn-NK@camel.ams6.corp.booking.com
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 <sprout@cpan.org>
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 <sprout@cpan.org>
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 <sprout@cpan.org>
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 <sprout@cpan.org>
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 <sprout@cpan.org>
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
-
[perl.git] branch sprout/overridesβ, updated. v5.15.9-269-ga514ada
by Father Chrysostomos