In perl.git, the branch sprout/overridesβ has been updated <http://perl5.git.perl.org/perl.git/commitdiff/408e0b3f2049554e1266a71ed9a54e1efcf7a990?hp=a514ada2b2efe361b923b1dac7b3cccfc8128100>
- Log ----------------------------------------------------------------- commit 408e0b3f2049554e1266a71ed9a54e1efcf7a990 Author: Father Chrysostomos <[email protected]> Date: Fri Apr 27 17:08:15 2012 -0700 File::Glob: Donât use the magic 2nd arg to glob This argument is going away, because it is undocumented, unused on CPAN outside of the core, and getting in the way of allowing glob() to be overridden properly. It gets in the way because, under the âoverridesâ feature (still a no-op), the glob keyword will be truly overridable, with no magic involved, but it will still be called by the built-in <...> operator, which consequently must not pass any magic second argument. See <https://rt.perl.org/rt3/Ticket/Display.html?id=108286>. M ext/File-Glob/Glob.pm M ext/File-Glob/Glob.xs commit 955200ed8cc3a662d9478c34a0816d9cce9ead77 Author: Father Chrysostomos <[email protected]> Date: Fri Apr 27 17:06:19 2012 -0700 Increase $File::Glob::VERSION to 1.18 M ext/File-Glob/Glob.pm commit 6cee74381e3090b6a0be400308c76891b7cfb057 Author: Father Chrysostomos <[email protected]> Date: Fri Apr 27 16:48:36 2012 -0700 DosGlob: Donât use the magic 2nd arg to glob This argument is going away, because it is undocumented, unused on CPAN outside of the core, and getting in the way of allowing glob() to be overridden properly. It gets in the way because, under the âoverridesâ feature (still a no-op), the glob keyword will be truly overridable, with no magic involved, but it will still be called by the built-in <...> operator, which consequently must not pass any magic second argument. See <https://rt.perl.org/rt3/Ticket/Display.html?id=108286>. M MANIFEST A ext/File-DosGlob/DosGlob.xs M ext/File-DosGlob/lib/File/DosGlob.pm M ext/File-DosGlob/t/DosGlob.t commit a75fd1e1d46c0e75cf2f50fad26a708f93901d99 Author: Father Chrysostomos <[email protected]> Date: Fri Apr 27 16:39:02 2012 -0700 Increse $File::DosGlob::VERSION to 1.07 M ext/File-DosGlob/lib/File/DosGlob.pm commit e228418117ce1ec8c1da63335ce6a2895a32e996 Author: Father Chrysostomos <[email protected]> Date: Fri Apr 27 14:05:39 2012 -0700 Move File::DosGlob from lib to ext M MANIFEST M Porting/Maintainers.pl A ext/File-DosGlob/lib/File/DosGlob.pm A ext/File-DosGlob/t/DosGlob.t D lib/File/DosGlob.pm D lib/File/DosGlob.t commit c958af4b33fcc362bc7ea56d747ae6c4e71e3591 Author: Father Chrysostomos <[email protected]> Date: Fri Apr 27 09:53:16 2012 -0700 Add &CORE::exists M gv.c M t/op/coreamp.t M t/op/coresubs.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 5 +++-- Porting/Maintainers.pl | 2 +- ext/File-DosGlob/DosGlob.xs | 18 ++++++++++++++++++ {lib => ext/File-DosGlob/lib}/File/DosGlob.pm | 10 +++++----- {lib/File => ext/File-DosGlob/t}/DosGlob.t | 7 ++++++- ext/File-Glob/Glob.pm | 4 ++-- ext/File-Glob/Glob.xs | 18 ++++++++---------- gv.c | 4 ++-- t/op/coreamp.t | 2 +- t/op/coresubs.t | 6 +++--- 10 files changed, 49 insertions(+), 27 deletions(-) create mode 100644 ext/File-DosGlob/DosGlob.xs rename {lib => ext/File-DosGlob/lib}/File/DosGlob.pm (98%) rename {lib/File => ext/File-DosGlob/t}/DosGlob.t (94%) diff --git a/MANIFEST b/MANIFEST index 2be6ea7..7badb62 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3720,6 +3720,9 @@ ext/FileCache/t/04twoarg.t See if FileCache works ext/FileCache/t/05override.t See if FileCache works ext/FileCache/t/06export.t See if FileCache exporting works ext/FileCache/t/07noimport.t See if FileCache works without importing +ext/File-DosGlob/DosGlob.xs Win32 DOS-globbing module +ext/File-DosGlob/lib/File/DosGlob.pm Win32 DOS-globbing module +ext/File-DosGlob/t/DosGlob.t See if File::DosGlob works ext/File-Glob/bsd_glob.c File::Glob extension run time code ext/File-Glob/bsd_glob.h File::Glob extension header file ext/File-Glob/Changes File::Glob extension changelog @@ -4249,8 +4252,6 @@ lib/File/Compare.pm Emulation of cmp command lib/File/Compare.t See if File::Compare works lib/File/Copy.pm Emulation of cp command lib/File/Copy.t See if File::Copy works -lib/File/DosGlob.pm Win32 DOS-globbing module -lib/File/DosGlob.t See if File::DosGlob works lib/File/Find.pm Routines to do a find lib/File/Find/t/find.t See if File::Find works lib/File/Find/t/taint.t See if File::Find works with taint diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index bef1e74..4f81193 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -788,7 +788,7 @@ use File::Glob qw(:case); 'File::DosGlob' => { 'MAINTAINER' => 'p5p', - 'FILES' => q[lib/File/DosGlob.{pm,t}], + 'FILES' => q[ext/File-DosGlob], 'UPSTREAM' => 'blead', }, diff --git a/ext/File-DosGlob/DosGlob.xs b/ext/File-DosGlob/DosGlob.xs new file mode 100644 index 0000000..b8a0612 --- /dev/null +++ b/ext/File-DosGlob/DosGlob.xs @@ -0,0 +1,18 @@ +#define PERL_NO_GET_CONTEXT + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +MODULE = File::DosGlob PACKAGE = File::DosGlob + +PROTOTYPES: DISABLE + +SV * +_callsite(...) + CODE: + RETVAL = newSVpvn( + (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *) + ); + OUTPUT: + RETVAL diff --git a/lib/File/DosGlob.pm b/ext/File-DosGlob/lib/File/DosGlob.pm similarity index 98% rename from lib/File/DosGlob.pm rename to ext/File-DosGlob/lib/File/DosGlob.pm index 7e57175..19be084 100644 --- a/lib/File/DosGlob.pm +++ b/ext/File-DosGlob/lib/File/DosGlob.pm @@ -9,10 +9,13 @@ package File::DosGlob; -our $VERSION = '1.06'; +our $VERSION = '1.07'; use strict; use warnings; +require XSLoader; +XSLoader::load(); + sub doglob { my $cond = shift; my @retval = (); @@ -109,15 +112,12 @@ sub doglob { my %entries; sub glob { - my($pat,$cxix) = @_; + my($pat,$cxix) = ($_[0], _callsite()); my @pat; # glob without args defaults to $_ $pat = $_ unless defined $pat; - # assume global context if not provided one - $cxix = '_G_' unless defined $cxix; - # if we're just beginning, do it all first if (!$entries{$cxix}) { # extract patterns diff --git a/lib/File/DosGlob.t b/ext/File-DosGlob/t/DosGlob.t similarity index 94% rename from lib/File/DosGlob.t rename to ext/File-DosGlob/t/DosGlob.t index 9227cb9..1e4f7f3 100644 --- a/lib/File/DosGlob.t +++ b/ext/File-DosGlob/t/DosGlob.t @@ -4,8 +4,13 @@ # test glob() in File::DosGlob # +# Make sure it can load before other XS extensions +use File::DosGlob; + +use FindBin; +use File::Spec::Functions; BEGIN { - chdir 't' if -d 't'; + chdir catfile $FindBin::Bin, (updir)x3, 't'; @INC = '../lib'; } diff --git a/ext/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index cd15922..ef82389 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -38,7 +38,7 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob" @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.17'; +$VERSION = '1.18'; sub import { require Exporter; @@ -71,7 +71,7 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) { # File::Glob::glob() is deprecated because its prototype is different from # CORE::glob() (use bsd_glob() instead) sub glob { - splice @_, 1; # don't pass PL_glob_index as flags! + splice @_, 1; # no flags goto &bsd_glob; } diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs index 3ea0590..c18bc30 100644 --- a/ext/File-Glob/Glob.xs +++ b/ext/File-Glob/Glob.xs @@ -75,10 +75,8 @@ iterate(pTHX_ bool(*globber)(pTHX_ AV *entries, SV *patsv)) SV *patsv = POPs; bool on_stack = FALSE; - /* assume global context if not provided one */ SvGETMAGIC(cxixsv); - if (SvOK(cxixsv)) cxixpv = SvPV_nomg(cxixsv, cxixlen); - else cxixpv = "_G_", cxixlen = 3; + cxixpv = SvPV_nomg(cxixsv, cxixlen); if (!MY_CXT.x_GLOB_ENTRIES) MY_CXT.x_GLOB_ENTRIES = newHV(); entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1)); @@ -354,14 +352,14 @@ void csh_glob(...) PPCODE: /* For backward-compatibility with the original Perl function, we sim- - * ply take the first two arguments, regardless of how many there are. + * ply take the first argument, regardless of how many there are. */ - if (items >= 2) SP += 2; + if (items) SP ++; else { - SP += items; XPUSHs(&PL_sv_undef); - if (!items) XPUSHs(&PL_sv_undef); } + XPUSHs(newSVpvn_flags((char *)&PL_op, sizeof(OP *), SVs_TEMP)); + sv_catpvs(*SP, "_"); /* Avoid conflicts with PL_glob_index */ PUTBACK; csh_glob_iter(aTHX); SPAGAIN; @@ -369,12 +367,12 @@ PPCODE: void bsd_glob_override(...) PPCODE: - if (items >= 2) SP += 2; + if (items) SP ++; else { - SP += items; XPUSHs(&PL_sv_undef); - if (!items) XPUSHs(&PL_sv_undef); } + XPUSHs(newSVpvn_flags((char *)&PL_op, sizeof(OP *), SVs_TEMP)); + sv_catpvs(*SP, "_"); /* Avoid conflicts with PL_glob_index */ PUTBACK; iterate(aTHX_ doglob_iter_wrapper); SPAGAIN; diff --git a/gv.c b/gv.c index a6f7f33..be32eee 100644 --- a/gv.c +++ b/gv.c @@ -460,7 +460,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, 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_exists : + 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_glob : case KEY_goto : case KEY_grep : case KEY_gt : case KEY_if: case KEY_INIT: case KEY_last: case KEY_le: @@ -477,7 +477,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, return NULL; case KEY_chdir: case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete: - case KEY_each: case KEY_eof: case KEY_exec: + case KEY_each : case KEY_eof : case KEY_exec : case KEY_exists: case KEY_keys: case KEY_lstat: case KEY_pop: diff --git a/t/op/coreamp.t b/t/op/coreamp.t index 25f5399..a092ac1 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -880,7 +880,7 @@ like $@, qr'^Undefined format "STDOUT" called', next if $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 + e|os)|e(?:ls(?:if|e)|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) diff --git a/t/op/coresubs.t b/t/op/coresubs.t index c9c2fe3..372c386 100644 --- a/t/op/coresubs.t +++ b/t/op/coresubs.t @@ -17,7 +17,7 @@ my $bd = new B::Deparse '-p'; 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 + cmp default do dump else elsif eq eval 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 @@ -50,9 +50,9 @@ while(<$kh>) { CORE::state $protochar = qr/([^\\]|\\(?:[^[]|\[[^]]+\]))/; my $numargs = - $word eq 'delete' ? 1 : + $word eq 'delete' || $word eq 'exists' ? 1 : (() = $proto =~ s/;.*//r =~ /\G$protochar/g); - my $suf = $word eq 'delete' ? '[0]' : ''; + my $suf = $word eq 'delete' || $word eq 'exists' ? '[0]' : ''; my $code = "#line 1 This-line-makes-__FILE__-easier-to-test. sub { () = (my$word(" -- Perl5 Master Repository
