In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/76cc365d064e9bf5a0e771bb8ae2bf380b8b0d25?hp=11d95c64b33c4850567d44b5bbaeaa74eeff1525>
- Log ----------------------------------------------------------------- commit 76cc365d064e9bf5a0e771bb8ae2bf380b8b0d25 Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 19:17:51 2010 +0200 Merge the XS code for Hash::Util::{hidden,legal}_ref_keys. Express Hash::Util::all_keys more tersely. M ext/Hash-Util/Util.xs commit 2caa6900bf5b16874efdd1f85c3db1c9f6bcb5fd Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 18:41:57 2010 +0200 Convert Hash::Util's XS code to use typemaps for dereferencing. This will subtly change the text of the parameter mismatch errors. M ext/Hash-Util/Util.xs commit 7bee1db7a7213960f0e993475537d52af34c2e34 Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 16:41:14 2010 +0200 Standardise Hash::Util::hv_store's error message. Previously it was inconsistent with the messages of the other XS routines, which used all-uppercase for HASH and ARRAY. M ext/Hash-Util/Util.xs commit b58f046e90bbd29d8ce6f6d13cd31c2b86d868e0 Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 16:13:47 2010 +0200 Convert Hash::Util, XS::APItest and XS::Typemap to XSLoader. None are using any DynaLoader specific functionality. M ext/Hash-Util/lib/Hash/Util.pm M ext/XS-APItest/APItest.pm M ext/XS-Typemap/Typemap.pm commit 6642cd871fb3dfba83e01e1a65bc2b4aa094387f Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 15:34:48 2010 +0200 Convert GDBM_File to an XS AUTOLOAD. M ext/GDBM_File/GDBM_File.pm M ext/GDBM_File/Makefile.PL commit b88ba6ea2d1d4c64ceab997d68b62a772f69b5c9 Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 14:17:09 2010 +0200 Use inlineable proxy constant subs for GDBM_File. M ext/GDBM_File/GDBM_File.pm M ext/GDBM_File/Makefile.PL commit 28cd8e1dfd44684db52b0c0d0ceafbe8b1be8d4e Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 11:21:45 2010 +0200 Convert File::Glob::bsd_glob to XS. Unlike doglob, it has no prototype, so it's not possible to use a simple ALIAS directive to make it and doglob aliases. M ext/File-Glob/Glob.pm M ext/File-Glob/Glob.xs commit 6736a914b824405200c697cf2f2bbc6cf8807fa2 Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 10:48:22 2010 +0200 For PROXYSUBS error messages, generate more efficient code for -Uusethreads. M cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm commit 7f39e0ae39033ab8b37028bcb877100291982e8e Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 09:32:16 2010 +0200 Convert Fcntl, File::Glob, I18N::Langinfo and Socket to an XS AUTOLOAD. All 4 use ExtUtils::Constant::ProxySubs, and only have an AUTOLOAD to deal with failed constant lookups. M ext/Fcntl/Fcntl.pm M ext/Fcntl/Makefile.PL M ext/File-Glob/Glob.pm M ext/File-Glob/Makefile.PL M ext/I18N-Langinfo/Langinfo.pm M ext/I18N-Langinfo/Makefile.PL M ext/Socket/Makefile.PL M ext/Socket/Socket.pm commit c565ab54dc649bb62cd4d57149d7b2abb21df5f3 Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 09:29:13 2010 +0200 Add an option autoload to PROXYSUBS, to generate an AUTOLOAD subroutine. Like croak_on_error, this is only useful with the Proxy Constant Subroutine code, as that adds all known constants to the symbol table at compile time. The (obvious) additional restriction is that directly implementing AUTOLOAD is only useful if the package wishes to perform no other autoloading, and to treat all autoload requests as (failed) constant lookups (with errors describing them as such). M cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm commit ad23561230a77db6d7024a31d7c63e91e40f439b Author: Nicholas Clark <[email protected]> Date: Wed Oct 20 09:25:36 2010 +0200 In Perl_gv_autoload4(), remove weakref before reassigning to CvSTASH() Fixes a minor bug introduced in 4c74a7df3242aa95. The underlying assumption of the XS AUTOLOAD implementation, that the fields are unused, remains invalid. M gv.c commit 735631af6fd7ee0a0db0185decce87cabe3eb134 Author: Nicholas Clark <[email protected]> Date: Tue Oct 19 20:37:06 2010 +0200 Convert Fcntl, File::Glob, I18N::Langinfo, POSIX and Socket to croak_on_error. This is possible because all 5 use ExtUtils::Constant::ProxySubs, so the constant() routine is only used for error conditions. M ext/Fcntl/Fcntl.pm M ext/Fcntl/Makefile.PL M ext/File-Glob/Glob.pm M ext/File-Glob/Makefile.PL M ext/I18N-Langinfo/Langinfo.pm M ext/I18N-Langinfo/Makefile.PL M ext/POSIX/Makefile.PL M ext/POSIX/lib/POSIX.pm M ext/Socket/Makefile.PL M ext/Socket/Socket.pm commit 04777d295957ad270188e4debf51b523e07cc5b0 Author: Nicholas Clark <[email protected]> Date: Tue Oct 19 20:17:22 2010 +0200 Add option croak_on_error to PROXYSUBS, to directly croak() the error message. This is only useful with the code that generates Proxy Constant Subroutines, as this adds all known constants to the symbol table at compile time, meaning that the only calls to AUTOLOAD will be to load constants not available on this platform, or for invalid constant names. M cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm M cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm commit 582b1831035a650863dea04ee407a7ec0ad505b2 Author: Nicholas Clark <[email protected]> Date: Tue Oct 19 20:04:24 2010 +0200 Change goto_xs.t to use Fcntl::S_IMODE() for testing. The behaviour of Fcntl::constant() is about to be changed. M t/op/goto_xs.t ----------------------------------------------------------------------- Summary of changes: cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm | 2 +- .../lib/ExtUtils/Constant/ProxySubs.pm | 77 +++++++++++++++- ext/Fcntl/Fcntl.pm | 15 +--- ext/Fcntl/Makefile.PL | 4 +- ext/File-Glob/Glob.pm | 26 +----- ext/File-Glob/Glob.xs | 16 +++- ext/File-Glob/Makefile.PL | 4 +- ext/GDBM_File/GDBM_File.pm | 14 +--- ext/GDBM_File/Makefile.PL | 1 + ext/Hash-Util/Util.xs | 94 +++++--------------- ext/Hash-Util/lib/Hash/Util.pm | 5 +- ext/I18N-Langinfo/Langinfo.pm | 25 +----- ext/I18N-Langinfo/Makefile.PL | 4 +- ext/POSIX/Makefile.PL | 4 +- ext/POSIX/lib/POSIX.pm | 10 +-- ext/Socket/Makefile.PL | 4 +- ext/Socket/Socket.pm | 14 +--- ext/XS-APItest/APItest.pm | 8 +- ext/XS-Typemap/Typemap.pm | 9 +- gv.c | 2 + t/op/goto_xs.t | 23 ++--- 21 files changed, 149 insertions(+), 212 deletions(-) diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm index 0a20b89..96e495b 100644 --- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm +++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm @@ -1,6 +1,6 @@ package ExtUtils::Constant; use vars qw (@ISA $VERSION @EXPORT_OK %EXPORT_TAGS); -$VERSION = 0.22; +$VERSION = 0.23; =head1 NAME diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm index c3a041c..1dcfd06 100644 --- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm +++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm @@ -9,7 +9,7 @@ require ExtUtils::Constant::XS; use ExtUtils::Constant::Utils qw(C_stringify); use ExtUtils::Constant::XS qw(%XS_TypeSet); -$VERSION = '0.07'; +$VERSION = '0.08'; @ISA = 'ExtUtils::Constant::XS'; %type_to_struct = @@ -170,6 +170,21 @@ sub WriteConstants { my $options = $ARGS->{PROXYSUBS}; $options = {} unless ref $options; my $explosives = $options->{croak_on_read}; + my $croak_on_error = $options->{croak_on_error}; + my $autoload = $options->{autoload}; + { + my $exclusive = 0; + ++$exclusive if $explosives; + ++$exclusive if $croak_on_error; + ++$exclusive if $autoload; + + # Until someone patches this (with test cases): + carp ("PROXYSUBS options 'autoload', 'croak_on_read' and 'croak_on_error' cannot be used together") + if $exclusive > 1; + } + # Strictly it requires Perl_caller_cx + carp ("PROXYSUBS options 'croak_on_error' requires v5.13.5 or later") + if $croak_on_error && $^V < v5.13.5; $xs_subname ||= 'constant'; @@ -200,7 +215,23 @@ sub WriteConstants { my $can_do_pcs = $] >= 5.009; my $cast_CONSTSUB = $] < 5.010 ? '(char *)' : ''; - print $c_fh $self->header(), <<"EOADD"; + print $c_fh $self->header(); + if ($autoload || $croak_on_error) { + print $c_fh <<'EOC'; + +/* This allows slightly more efficient code on !USE_ITHREADS: */ +#ifdef USE_ITHREADS +# define COP_FILE(c) CopFILE(c) +# define COP_FILE_F "s" +#else +# define COP_FILE(c) CopFILESV(c) +# define COP_FILE_F SVf +#endif +EOC + } + + print $c_fh <<"EOADD"; + static void ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) { EOADD @@ -519,7 +550,45 @@ EOBOOT EOBOOT } - print $xs_fh $explosives ? <<"EXPLODE" : <<"DONT"; + if ($croak_on_error || $autoload) { + print $xs_fh $croak_on_error ? <<"EOC" : <<'EOA'; + +void +$xs_subname(sv) + INPUT: + SV * sv; + PREINIT: + const PERL_CONTEXT *cx = caller_cx(0, NULL); + /* cx is NULL if we've been called from the top level. PL_curcop isn't + ideal, but it's much cheaper than other ways of not going SEGV. */ + const COP *cop = cx ? cx->blk_oldcop : PL_curcop; +EOC + +void +AUTOLOAD() + PROTOTYPE: DISABLE + PREINIT: + SV *sv = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SVs_TEMP | SvUTF8(cv)); + const COP *cop = PL_curcop; +EOA + print $xs_fh <<"EOC"; + PPCODE: +#ifndef SYMBIAN + HV *${c_subname}_missing = get_missing_hash(aTHX); + if (hv_exists_ent(${c_subname}_missing, sv, 0)) { + sv = newSVpvf("Your vendor has not defined $package_sprintf_safe macro %" SVf + ", used at %" COP_FILE_F " line %d\\n", sv, + COP_FILE(cop), CopLINE(cop)); + } else +#endif + { + sv = newSVpvf("%"SVf" is not a valid $package_sprintf_safe macro at %" + COP_FILE_F " line %d\\n", sv, COP_FILE(cop), CopLINE(cop)); + } + croak_sv(sv_2mortal(sv)); +EOC + } else { + print $xs_fh $explosives ? <<"EXPLODE" : <<"DONT"; void $xs_subname(sv) @@ -549,7 +618,7 @@ $xs_subname(sv) } PUSHs(sv_2mortal(sv)); DONT - + } } 1; diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 970735c..b1d2051 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -56,7 +56,7 @@ See L<perlfunc/stat> about the S_I* constants. =cut use strict; -our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $AUTOLOAD); +our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); require Exporter; require XSLoader; @@ -183,17 +183,4 @@ XSLoader::load(); O_NOTRANS ), map {...@{$_}} values %EXPORT_TAGS); -sub AUTOLOAD { - (my $constname = $AUTOLOAD) =~ s/.*:://; - die "&Fcntl::constant not defined" if $constname eq 'constant'; - my ($error, $val) = constant($constname); - if ($error) { - my (undef,$file,$line) = caller; - die "$error at $file line $line\n"; - } - no strict 'refs'; - *$AUTOLOAD = sub { $val }; - goto &$AUTOLOAD; -} - 1; diff --git a/ext/Fcntl/Makefile.PL b/ext/Fcntl/Makefile.PL index 2bed754..cb8a8e6 100644 --- a/ext/Fcntl/Makefile.PL +++ b/ext/Fcntl/Makefile.PL @@ -1,5 +1,5 @@ use ExtUtils::MakeMaker; -use ExtUtils::Constant 0.11 'WriteConstants'; +use ExtUtils::Constant 0.23 'WriteConstants'; WriteMakefile( NAME => 'Fcntl', XSPROTOARG => '-noprototypes', # XXX remove later? @@ -39,7 +39,7 @@ my @names = (qw( {name=>"SEEK_END", default=>["IV", "2"]}, {name=>"_S_IFMT", macro=>"S_IFMT", value=>"S_IFMT"}); WriteConstants( - PROXYSUBS => 1, + PROXYSUBS => {autoload => 1}, NAME => 'Fcntl', NAMES => \...@names, ); diff --git a/ext/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index 4219c7e..eead378 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -1,8 +1,7 @@ package File::Glob; use strict; -our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, - $AUTOLOAD, $DEFAULT_FLAGS); +our($VERSION, @ISA, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, $DEFAULT_FLAGS); require XSLoader; use feature 'switch'; @@ -37,7 +36,7 @@ use feature 'switch'; @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.09'; +$VERSION = '1.10'; sub import { require Exporter; @@ -57,21 +56,6 @@ sub import { } @_); } -sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. - - my $constname; - ($constname = $AUTOLOAD) =~ s/.*:://; - my ($error, $val) = constant($constname); - if ($error) { - require Carp; - Carp::croak($error); - } - eval "sub $AUTOLOAD { $val }"; - goto &$AUTOLOAD; -} - XSLoader::load(); $DEFAULT_FLAGS = GLOB_CSH(); @@ -79,12 +63,6 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) { $DEFAULT_FLAGS |= GLOB_NOCASE(); } -sub bsd_glob { - my ($pat,$flags) = @_; - $flags = $DEFAULT_FLAGS if @_ < 2; - return doglob($pat,$flags); -} - # File::Glob::glob() is deprecated because its prototype is different from # CORE::glob() (use bsd_glob() instead) sub glob { diff --git a/ext/File-Glob/Glob.xs b/ext/File-Glob/Glob.xs index 30e7f82..8543a04 100644 --- a/ext/File-Glob/Glob.xs +++ b/ext/File-Glob/Glob.xs @@ -36,11 +36,6 @@ GLOB_ERROR() OUTPUT: RETVAL -BOOT: -{ - MY_CXT_INIT; -} - void doglob(pattern,...) char *pattern @@ -54,10 +49,13 @@ PREINIT: PPCODE: { dMY_CXT; + dXSI32; /* allow for optional flags argument */ if (items > 1) { flags = (int) SvIV(ST(1)); + } else if (ix) { + flags = (int) SvIV(get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)); } /* call glob */ @@ -78,4 +76,12 @@ PPCODE: bsd_globfree(&pglob); } +BOOT: +{ + CV *cv = newXS("File::Glob::bsd_glob", XS_File__Glob_doglob, __FILE__); + XSANY.any_i32 = 1; + + MY_CXT_INIT; +} + INCLUDE: const-xs.inc diff --git a/ext/File-Glob/Makefile.PL b/ext/File-Glob/Makefile.PL index 790613b..b26dc31 100644 --- a/ext/File-Glob/Makefile.PL +++ b/ext/File-Glob/Makefile.PL @@ -1,5 +1,5 @@ use ExtUtils::MakeMaker; -use ExtUtils::Constant 0.11 'WriteConstants'; +use ExtUtils::Constant 0.23 'WriteConstants'; WriteMakefile( NAME => 'File::Glob', VERSION_FROM => 'Glob.pm', @@ -22,7 +22,7 @@ sub MY::cflags { } WriteConstants( - PROXYSUBS => 1, + PROXYSUBS => {autoload => 1}, NAME => 'File::Glob', NAMES => [qw(GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_ERR GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index 6f92d18..8508564 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -43,7 +43,7 @@ package GDBM_File; use strict; use warnings; -our($VERSION, @ISA, @EXPORT, $AUTOLOAD); +our($VERSION, @ISA, @EXPORT); require Carp; require Tie::Hash; @@ -69,17 +69,7 @@ require XSLoader; ); # This module isn't dual life, so no need for dev version numbers. -$VERSION = '1.11'; - -sub AUTOLOAD { - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - my ($error, $val) = constant($constname); - Carp::croak $error if $error; - no strict 'refs'; - *{$AUTOLOAD} = sub { $val }; - goto &{$AUTOLOAD}; -} +$VERSION = '1.12'; XSLoader::load(); diff --git a/ext/GDBM_File/Makefile.PL b/ext/GDBM_File/Makefile.PL index 24e6ee4..2a44d3e 100644 --- a/ext/GDBM_File/Makefile.PL +++ b/ext/GDBM_File/Makefile.PL @@ -12,6 +12,7 @@ WriteConstants( NAME => 'GDBM_File', DEFAULT_TYPE => 'IV', BREAKOUT_AT => 8, + PROXYSUBS => {autoload => 1}, NAMES => [qw(GDBM_CACHESIZE GDBM_CENTFREE GDBM_COALESCEBLKS GDBM_FAST GDBM_FASTMODE GDBM_INSERT GDBM_NEWDB GDBM_NOLOCK GDBM_OPENMASK GDBM_READER GDBM_REPLACE GDBM_SYNC GDBM_SYNCMODE diff --git a/ext/Hash-Util/Util.xs b/ext/Hash-Util/Util.xs index 571d48b..d835ede 100644 --- a/ext/Hash-Util/Util.xs +++ b/ext/Hash-Util/Util.xs @@ -2,110 +2,60 @@ #include "perl.h" #include "XSUB.h" - MODULE = Hash::Util PACKAGE = Hash::Util - -SV* +void all_keys(hash,keys,placeholder) - SV* hash - SV* keys - SV* placeholder + HV *hash + AV *keys + AV *placeholder PROTOTYPE: \...@\@ PREINIT: - AV* av_k; - AV* av_p; - HV* hv; SV *key; HE *he; - CODE: - if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV) - croak("First argument to all_keys() must be an HASH reference"); - if (!SvROK(keys) || SvTYPE(SvRV(keys)) != SVt_PVAV) - croak("Second argument to all_keys() must be an ARRAY reference"); - if (!SvROK(placeholder) || SvTYPE(SvRV(placeholder)) != SVt_PVAV) - croak("Third argument to all_keys() must be an ARRAY reference"); - - hv = (HV*)SvRV(hash); - av_k = (AV*)SvRV(keys); - av_p = (AV*)SvRV(placeholder); - - av_clear(av_k); - av_clear(av_p); + PPCODE: + av_clear(keys); + av_clear(placeholder); - (void)hv_iterinit(hv); - while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) { + (void)hv_iterinit(hash); + while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) { key=hv_iterkeysv(he); - if (HeVAL(he) == &PL_sv_placeholder) { - SvREFCNT_inc(key); - av_push(av_p, key); - } else { - SvREFCNT_inc(key); - av_push(av_k, key); - } + av_push(HeVAL(he) == &PL_sv_placeholder ? placeholder : keys, + SvREFCNT_inc(key)); } - RETVAL=hash; - + XSRETURN(1); void hidden_ref_keys(hash) - SV* hash + HV *hash + ALIAS: + Hash::Util::legal_ref_keys = 1 PREINIT: - HV* hv; + dXSI32; SV *key; HE *he; PPCODE: - if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV) - croak("First argument to hidden_keys() must be an HASH reference"); - - hv = (HV*)SvRV(hash); - - (void)hv_iterinit(hv); - while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) { + (void)hv_iterinit(hash); + while((he = hv_iternext_flags(hash, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) { key=hv_iterkeysv(he); - if (HeVAL(he) == &PL_sv_placeholder) { + if (ix || HeVAL(he) == &PL_sv_placeholder) { XPUSHs( key ); } } void -legal_ref_keys(hash) - SV* hash - PREINIT: - HV* hv; - SV *key; - HE *he; - PPCODE: - if (!SvROK(hash) || SvTYPE(SvRV(hash)) != SVt_PVHV) - croak("First argument to legal_keys() must be an HASH reference"); - - hv = (HV*)SvRV(hash); - - (void)hv_iterinit(hv); - while((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))!= NULL) { - key=hv_iterkeysv(he); - XPUSHs( key ); - } - -void -hv_store(hvref, key, val) - SV* hvref +hv_store(hash, key, val) + HV *hash SV* key SV* val PROTOTYPE: \%$$ - PREINIT: - HV* hv; CODE: { - if (!SvROK(hvref) || SvTYPE(SvRV(hvref)) != SVt_PVHV) - croak("First argument to hv_store() must be a hash reference"); - hv = (HV*)SvRV(hvref); SvREFCNT_inc(val); - if (!hv_store_ent(hv, key, val, 0)) { + if (!hv_store_ent(hash, key, val, 0)) { SvREFCNT_dec(val); XSRETURN_NO; } else { XSRETURN_YES; } } - diff --git a/ext/Hash-Util/lib/Hash/Util.pm b/ext/Hash-Util/lib/Hash/Util.pm index 49d38e0..1e7ae3d 100644 --- a/ext/Hash-Util/lib/Hash/Util.pm +++ b/ext/Hash-Util/lib/Hash/Util.pm @@ -30,9 +30,8 @@ our @EXPORT_OK = qw( ); our $VERSION = '0.09'; -require DynaLoader; -local @ISA = qw(DynaLoader); -bootstrap Hash::Util $VERSION; +require XSLoader; +XSLoader::load(); sub import { my $class = shift; diff --git a/ext/I18N-Langinfo/Langinfo.pm b/ext/I18N-Langinfo/Langinfo.pm index 51d0d4d..8af32de 100644 --- a/ext/I18N-Langinfo/Langinfo.pm +++ b/ext/I18N-Langinfo/Langinfo.pm @@ -72,30 +72,7 @@ our @EXPORT_OK = qw( YESSTR ); -our $VERSION = '0.06'; - -sub AUTOLOAD { - # This AUTOLOAD is used to 'autoload' constants from the constant() - # XS function. - - my $constname; - our $AUTOLOAD; - ($constname = $AUTOLOAD) =~ s/.*:://; - croak "&I18N::Langinfo::constant not defined" if $constname eq 'constant'; - my ($error, $val) = constant($constname); - if ($error) { croak $error; } - { - no strict 'refs'; - # Fixed between 5.005_53 and 5.005_61 -#XXX if ($] >= 5.00561) { -#XXX *$AUTOLOAD = sub () { $val }; -#XXX } -#XXX else { - *$AUTOLOAD = sub { $val }; -#XXX } - } - goto &$AUTOLOAD; -} +our $VERSION = '0.07'; XSLoader::load(); diff --git a/ext/I18N-Langinfo/Makefile.PL b/ext/I18N-Langinfo/Makefile.PL index 56c3aee..b5ed77f 100644 --- a/ext/I18N-Langinfo/Makefile.PL +++ b/ext/I18N-Langinfo/Makefile.PL @@ -1,5 +1,5 @@ use ExtUtils::MakeMaker; -use ExtUtils::Constant; +use ExtUtils::Constant 0.23; WriteMakefile( 'NAME' => 'I18N::Langinfo', @@ -30,7 +30,7 @@ push @names, # This lot are only enums for __SVR4_I386_ABI_L1__: foreach qw (CRNCYSTR THOUSEP RADIXCHAR); ExtUtils::Constant::WriteConstants( - PROXYSUBS => 1, + PROXYSUBS => {autoload => 1}, NAME => 'I18N::Langinfo', NAMES => \...@names, ); diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index 4a2c08a..0e994a6 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -1,6 +1,6 @@ # Expect this line to be read by t/posix.t, don't change it use ExtUtils::MakeMaker; -use ExtUtils::Constant 0.11 'WriteConstants'; +use ExtUtils::Constant 0.23 'WriteConstants'; use Config; my $rt_signals; if ($Config{sig_name} =~ /\bRTMIN\b/ && $Config{sig_name} =~ /\bRTMAX\b/) { @@ -119,7 +119,7 @@ if ($rt_signals) { } WriteConstants( - PROXYSUBS => 1, + PROXYSUBS => {croak_on_error => 1}, NAME => 'POSIX', NAMES => \...@names, ); diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index fbbbcd1..1071b3b 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our(@ISA, %EXPORT_TAGS, @EXPORT_OK, @EXPORT, $AUTOLOAD, %SIGRT) = (); -our $VERSION = "1.21"; +our $VERSION = "1.22"; use AutoLoader; @@ -36,21 +36,15 @@ sub usage; XSLoader::load(); sub AUTOLOAD { - no strict; no warnings 'uninitialized'; if ($AUTOLOAD =~ /::(_?[a-z])/) { # require AutoLoader; $AutoLoader::AUTOLOAD = $AUTOLOAD; goto &AutoLoader::AUTOLOAD } - local $! = 0; my $constname = $AUTOLOAD; $constname =~ s/.*:://; - my ($error, $val) = constant($constname); - croak $error if $error; - *$AUTOLOAD = sub { $val }; - - goto &$AUTOLOAD; + constant($constname); } package POSIX::SigAction; diff --git a/ext/Socket/Makefile.PL b/ext/Socket/Makefile.PL index 043f482..7167aa4 100644 --- a/ext/Socket/Makefile.PL +++ b/ext/Socket/Makefile.PL @@ -1,5 +1,5 @@ use ExtUtils::MakeMaker; -use ExtUtils::Constant 0.11 'WriteConstants'; +use ExtUtils::Constant 0.23 'WriteConstants'; use Config; WriteMakefile( NAME => 'Socket', @@ -72,7 +72,7 @@ push @names, foreach qw(INADDR_ANY INADDR_LOOPBACK INADDR_NONE INADDR_BROADCAST); WriteConstants( - PROXYSUBS => 1, + PROXYSUBS => {autoload => 1}, NAME => 'Socket', NAMES => \...@names, ); diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index 1cffe6b..da70114 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -1,7 +1,7 @@ package Socket; our($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = "1.90"; +$VERSION = "1.91"; =head1 NAME @@ -431,18 +431,6 @@ sub sockaddr_un { } } -sub AUTOLOAD { - my($constname); - ($constname = $AUTOLOAD) =~ s/.*:://; - croak "&Socket::constant not defined" if $constname eq 'constant'; - my ($error, $val) = constant($constname); - if ($error) { - croak $error; - } - *$AUTOLOAD = sub { $val }; - goto &$AUTOLOAD; -} - XSLoader::load(); 1; diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index bb95682..fdc5b54 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -use base 'DynaLoader'; +require XSLoader; # Export everything since these functions are only used by a test script # Export subpackages too - in effect, export all their routines into us, then @@ -50,7 +50,7 @@ sub import { } } -our $VERSION = '0.23'; +our $VERSION = '0.24'; use vars '$WARNINGS_ON_BOOTSTRAP'; use vars map "\$${_}_called_PP", qw(BEGIN UNITCHECK CHECK INIT END); @@ -87,11 +87,11 @@ END { } if ($WARNINGS_ON_BOOTSTRAP) { - bootstrap XS::APItest $VERSION; + XSLoader::load(); } else { # More CHECK and INIT blocks that could warn: local $^W; - bootstrap XS::APItest $VERSION; + XSLoader::load(); } 1; diff --git a/ext/XS-Typemap/Typemap.pm b/ext/XS-Typemap/Typemap.pm index 04776f0..f954d81 100644 --- a/ext/XS-Typemap/Typemap.pm +++ b/ext/XS-Typemap/Typemap.pm @@ -31,12 +31,12 @@ to the test script. =cut -use base qw/ DynaLoader Exporter /; - +use parent qw/ Exporter /; +require XSLoader; use vars qw/ $VERSION @EXPORT /; -$VERSION = '0.03'; +$VERSION = '0.04'; @EXPORT = (qw/ T_SV @@ -73,8 +73,7 @@ $VERSION = '0.03'; T_STDIO_open T_STDIO_close T_STDIO_print /); - -bootstrap XS::Typemap; +XSLoader::load(); =head1 NOTES diff --git a/gv.c b/gv.c index 91f68b3..17ffc2c 100644 --- a/gv.c +++ b/gv.c @@ -795,6 +795,8 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) * and split that value on the last '::', * pass along the same data via some unused fields in the CV */ + if (CvSTASH(cv)) + sv_del_backref(MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv)); CvSTASH(cv) = stash; if (stash) Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(cv)); diff --git a/t/op/goto_xs.t b/t/op/goto_xs.t index 6505889..3d4afee 100644 --- a/t/op/goto_xs.t +++ b/t/op/goto_xs.t @@ -25,18 +25,15 @@ print "1..11\n"; # We don't know what symbols are defined in platform X's system headers. # We don't even want to guess, because some platform out there will -# likely do the unthinkable. However, Fcntl::constant("LOCK_SH",0) -# should always return a value, even on platforms which don't define the -# cpp symbol; Fcntl.xs says: -# /* We support flock() on systems which don't have it, so -# always supply the constants. */ +# likely do the unthinkable. However, Fcntl::S_IMODE(0) +# should always return a value. # If this ceases to be the case, we're in trouble. =) -$VALID = 'LOCK_SH'; +$VALID = 0; -### First, we check whether Fcntl::constant returns sane answers. -# Fcntl::constant("LOCK_SH",0) should always succeed. +### First, we check whether Fcntl::S_IMODE returns sane answers. +# Fcntl::S_IMODE(0) should always succeed. -$value = Fcntl::constant($VALID); +$value = Fcntl::S_IMODE($VALID); print((!defined $value) ? "not ok 1\n# Sanity check broke, remaining tests will fail.\n" : "ok 1\n"); @@ -44,13 +41,13 @@ print((!defined $value) ### OK, we're ready to do real tests. # test "goto &function_constant" -sub goto_const { goto &Fcntl::constant; } +sub goto_const { goto &Fcntl::S_IMODE; } $ret = goto_const($VALID); print(($ret == $value) ? "ok 2\n" : "not ok 2\n# ($ret != $value)\n"); # test "goto &$function_package_and_name" -$FNAME1 = 'Fcntl::constant'; +$FNAME1 = 'Fcntl::S_IMODE'; sub goto_name1 { goto &$FNAME1; } $ret = goto_name1($VALID); @@ -64,7 +61,7 @@ print(($ret == $value) ? "ok 5\n" : "not ok 5\n# ($ret != $value)\n"); # test "goto &$function_name" from local package package Fcntl; -$FNAME2 = 'constant'; +$FNAME2 = 'S_IMODE'; sub goto_name2 { goto &$FNAME2; } package main; @@ -72,7 +69,7 @@ $ret = Fcntl::goto_name2($VALID); print(($ret == $value) ? "ok 6\n" : "not ok 6\n# ($ret != $value)\n"); # test "goto &$function_ref" -$FREF = \&Fcntl::constant; +$FREF = \&Fcntl::S_IMODE; sub goto_ref { goto &$FREF; } $ret = goto_ref($VALID); -- Perl5 Master Repository
