diff options
author | gregor herrmann <gregoa@debian.org> | 2023-09-30 02:18:48 +0200 |
---|---|---|
committer | gregor herrmann <gregoa@debian.org> | 2023-09-30 02:18:48 +0200 |
commit | 3663199fee37611e73aa0d9b23c7f61ebf1471fd (patch) | |
tree | 00ac42f5c39a35ecbecfa7d539a74dfb74753277 | |
parent | 77c830b298e6824e41fa9dcb104b7d22d75cdd39 (diff) |
New upstream version 0.13
-rw-r--r-- | .editorconfig | 4 | ||||
-rw-r--r-- | Build.PL | 9 | ||||
-rw-r--r-- | Changes | 9 | ||||
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | META.json | 6 | ||||
-rw-r--r-- | META.yml | 6 | ||||
-rw-r--r-- | hax/newOP_CUSTOM.c.inc | 2 | ||||
-rw-r--r-- | hax/perl-additions.c.inc | 13 | ||||
-rw-r--r-- | hax/perl-backcompat.c.inc | 39 | ||||
-rw-r--r-- | lib/Syntax/Keyword/Dynamically.pm | 27 | ||||
-rw-r--r-- | lib/Syntax/Keyword/Dynamically.xs | 18 | ||||
-rw-r--r-- | t/01dynamically.t | 8 | ||||
-rw-r--r-- | t/80dynamically+Object-Pad.t | 6 | ||||
-rw-r--r-- | t/81async-method+dynamically.t | 6 |
14 files changed, 114 insertions, 40 deletions
diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..24b6e3b --- /dev/null +++ b/.editorconfig @@ -0,0 +1,4 @@ +root = true + +[*.{pm,pl,t}] +indent_size = 3 @@ -6,6 +6,13 @@ use Module::Build; use Future::AsyncAwait::ExtensionBuilder; use XS::Parse::Keyword::Builder; +my @extra_compiler_flags = qw( -I. -Ihax -ggdb ); + +# MSWin32 needs NO_XSLOCKS to make longjmp work. +if( $^O eq "MSWin32" ) { + push @extra_compiler_flags, "-DNO_XSLOCKS=1"; +} + my $build = Module::Build->new( module_name => "Syntax::Keyword::Dynamically", test_requires => { @@ -20,7 +27,7 @@ my $build = Module::Build->new( 'perl' => '5.014', # pluggable keywords, XOP 'XS::Parse::Keyword' => '0.13', }, - extra_compiler_flags => [qw( -I. -Ihax -ggdb )], + extra_compiler_flags => \@extra_compiler_flags, license => 'perl', create_license => 1, create_readme => 1, @@ -1,5 +1,14 @@ Revision history for Syntax-Keyword-Dynamically +0.13 2023-09-21 + [CHANGES] + * Remember to implement `no Syntax::Keyword::Dynamically` + * Avoid multiple accesses to `PL_modglobal` at once when in + `-DMULTIPLICITY` + + [BUGFIXES] + * Need to set `-DNO_XLOCKS=1` to keep MSWin32 happy (RT149716) + 0.12 2023-03-04 [CHANGES] * Swap all unit tests from `Test::More` to `Test2::V0` @@ -1,3 +1,4 @@ +.editorconfig Build.PL Changes hax/newOP_CUSTOM.c.inc @@ -4,7 +4,7 @@ "Paul Evans <leonerd@leonerd.org.uk>" ], "dynamic_config" : 1, - "generated_by" : "Module::Build version 0.4231", + "generated_by" : "Module::Build version 0.4234", "license" : [ "perl_5" ], @@ -41,7 +41,7 @@ "provides" : { "Syntax::Keyword::Dynamically" : { "file" : "lib/Syntax/Keyword/Dynamically.pm", - "version" : "0.12" + "version" : "0.13" } }, "release_status" : "stable", @@ -51,6 +51,6 @@ ], "x_IRC" : "irc://irc.perl.org/#io-async" }, - "version" : "0.12", + "version" : "0.13", "x_serialization_backend" : "JSON::PP version 4.07" } @@ -10,7 +10,7 @@ configure_requires: Module::Build: '0.4004' XS::Parse::Keyword::Builder: '0.13' dynamic_config: 1 -generated_by: 'Module::Build version 0.4231, CPAN::Meta::Converter version 2.150010' +generated_by: 'Module::Build version 0.4234, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -19,12 +19,12 @@ name: Syntax-Keyword-Dynamically provides: Syntax::Keyword::Dynamically: file: lib/Syntax/Keyword/Dynamically.pm - version: '0.12' + version: '0.13' requires: XS::Parse::Keyword: '0.13' perl: '5.014' resources: IRC: irc://irc.perl.org/#io-async license: http://dev.perl.org/licenses/ -version: '0.12' +version: '0.13' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/hax/newOP_CUSTOM.c.inc b/hax/newOP_CUSTOM.c.inc index 9bf7ab3..c5ce17e 100644 --- a/hax/newOP_CUSTOM.c.inc +++ b/hax/newOP_CUSTOM.c.inc @@ -88,7 +88,7 @@ static OP *S_newLOGOP_CUSTOM(pTHX_ OP *(*func)(pTHX), U32 flags, OP *first, OP * logop->op_first = first; logop->op_flags = (U8)(flags | OPf_KIDS); logop->op_other = LINKLIST(other); - /* logop->op_private has nothing interesting for OP_CUSTOM */ + logop->op_private = (U8)(1 | (flags >> 8)); /* Link in postfix order */ logop->op_next = LINKLIST(first); diff --git a/hax/perl-additions.c.inc b/hax/perl-additions.c.inc index 939b64b..565b08b 100644 --- a/hax/perl-additions.c.inc +++ b/hax/perl-additions.c.inc @@ -10,6 +10,10 @@ # define hv_deletes(hv, skey, flags) hv_delete((hv), ("" skey ""), (sizeof(skey) - 1), flags) #endif +#ifndef gv_fetchmeth_pvs +# define gv_fetchmeth_pvs(stash, name, level, flags) gv_fetchmeth_pvn((stash), ("" name ""), (sizeof(name) - 1), level, flags) +#endif + #if HAVE_PERL_VERSION(5, 22, 0) # define PadnameOUTER_off(pn) (PadnameFLAGS(pn) &= ~PADNAMEt_OUTER) #else @@ -173,12 +177,13 @@ static void S_ensure_module_version(pTHX_ SV *module, SV *version) } #if HAVE_PERL_VERSION(5, 16, 0) + /* TODO: perl 5.14 lacks HvNAMEUTF8, gv_fetchmeth_pvn() */ # define fetch_superclass_method_pv(stash, pv, len, level) S_fetch_superclass_method_pv(aTHX_ stash, pv, len, level) static CV *S_fetch_superclass_method_pv(pTHX_ HV *stash, const char *pv, STRLEN len, U32 level) { -#if HAVE_PERL_VERSION(5, 18, 0) +# if HAVE_PERL_VERSION(5, 18, 0) GV *gv = gv_fetchmeth_pvn(stash, pv, len, level, GV_SUPER); -#else +# else SV *superclassname = newSVpvf("%*s::SUPER", HvNAMELEN_get(stash), HvNAME_get(stash)); if(HvNAMEUTF8(stash)) SvUTF8_on(superclassname); @@ -186,13 +191,13 @@ static CV *S_fetch_superclass_method_pv(pTHX_ HV *stash, const char *pv, STRLEN HV *superstash = gv_stashsv(superclassname, GV_ADD); GV *gv = gv_fetchmeth_pvn(superstash, pv, len, level, 0); -#endif +# endif if(!gv) return NULL; return GvCV(gv); } -#endif +#endif /* HAVE_PERL_VERSION(5, 16, 0) */ #define get_class_isa(stash) S_get_class_isa(aTHX_ stash) static AV *S_get_class_isa(pTHX_ HV *stash) diff --git a/hax/perl-backcompat.c.inc b/hax/perl-backcompat.c.inc index 44bd8f7..cfc96c9 100644 --- a/hax/perl-backcompat.c.inc +++ b/hax/perl-backcompat.c.inc @@ -50,6 +50,14 @@ static PADNAME *S_newPADNAMEpvn(pTHX_ const char *pv, STRLEN n) # define av_count(av) (AvFILL(av) + 1) #endif +#ifndef av_fetch_simple +# define av_fetch_simple(av, idx, lval) av_fetch(av, idx, lval) +#endif + +#ifndef av_push_simple +# define av_push_simple(av, sv) av_push(av, sv) +#endif + #ifndef av_top_index # define av_top_index(av) AvFILL(av) #endif @@ -164,6 +172,11 @@ static PADOFFSET MY_pad_add_name(pTHX_ const char *name, STRLEN len, U32 flags, # define isIDCONT_utf8_safe(s, e) (PERL_UNUSED_ARG(e), isIDCONT_utf8(s)) #endif +#ifndef CXp_EVALBLOCK +/* before perl 5.34 this was called CXp_TRYBLOCK */ +# define CXp_EVALBLOCK CXp_TRYBLOCK +#endif + #if !HAVE_PERL_VERSION(5, 26, 0) # define sv_set_undef(sv) sv_setsv(sv, &PL_sv_undef) #endif @@ -193,13 +206,25 @@ static bool MY_sv_derived_from_hv(pTHX_ SV *sv, HV *hv) } #endif -#ifdef PERL_USE_GCC_BRACE_GROUPS -# define xV_FROM_REF(XV, ref) \ +#ifndef xV_FROM_REF +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define xV_FROM_REF(XV, ref) \ ({ SV *_ref = ref; assert(SvROK(_ref)); assert(SvTYPE(SvRV(_ref)) == SVt_PV ## XV); (XV *)(SvRV(_ref)); }) -#else -# define xV_FROM_REF(XV, ref) ((XV *)SvRV(ref)) +# else +# define xV_FROM_REF(XV, ref) ((XV *)SvRV(ref)) +# endif + +# define AV_FROM_REF(ref) xV_FROM_REF(AV, ref) +# define CV_FROM_REF(ref) xV_FROM_REF(CV, ref) +# define HV_FROM_REF(ref) xV_FROM_REF(HV, ref) #endif -#define AV_FROM_REF(ref) xV_FROM_REF(AV, ref) -#define CV_FROM_REF(ref) xV_FROM_REF(CV, ref) -#define HV_FROM_REF(ref) xV_FROM_REF(HV, ref) +#ifndef newPADxVOP +# define newPADxVOP(type, flags, padix) S_newPADxVOP(aTHX_ type, flags, padix) +static OP *S_newPADxVOP(pTHX_ I32 type, I32 flags, PADOFFSET padix) +{ + OP *op = newOP(type, flags); + op->op_targ = padix; + return op; +} +#endif diff --git a/lib/Syntax/Keyword/Dynamically.pm b/lib/Syntax/Keyword/Dynamically.pm index b79a16a..a9dc367 100644 --- a/lib/Syntax/Keyword/Dynamically.pm +++ b/lib/Syntax/Keyword/Dynamically.pm @@ -1,9 +1,9 @@ # You may distribute under the terms of either the GNU General Public License # or the Artistic License (the same terms as Perl itself) # -# (C) Paul Evans, 2018-2020 -- leonerd@leonerd.org.uk +# (C) Paul Evans, 2018-2023 -- leonerd@leonerd.org.uk -package Syntax::Keyword::Dynamically 0.12; +package Syntax::Keyword::Dynamically 0.13; use v5.14; use warnings; @@ -109,19 +109,30 @@ meantime. sub import { - my $class = shift; + my $pkg = shift; my $caller = caller; - $class->import_into( $caller, @_ ); + $pkg->import_into( $caller, @_ ); } -sub import_into +sub unimport { - my $class = shift; - my ( $caller, @syms ) = @_; + my $pkg = shift; + my $caller = caller; + + $pkg->unimport_into( $caller, @_ ); +} + +sub import_into { shift->apply( sub { $^H{ $_[0] }++ }, @_ ) } +sub unimport_into { shift->apply( sub { delete $^H{ $_[0] } }, @_ ) } + +sub apply +{ + my $pkg = shift; + my ( $cb, $caller, @syms ) = @_; my %syms = map { $_ => 1 } @syms; - $^H{"Syntax::Keyword::Dynamically/dynamically"}++; + $cb->( "Syntax::Keyword::Dynamically/dynamically" ); _enable_async_mode() if delete $syms{'-async'}; diff --git a/lib/Syntax/Keyword/Dynamically.xs b/lib/Syntax/Keyword/Dynamically.xs index f25ef01..ac6b6e1 100644 --- a/lib/Syntax/Keyword/Dynamically.xs +++ b/lib/Syntax/Keyword/Dynamically.xs @@ -190,11 +190,13 @@ static void S_pushdynhelem(pTHX_ HV *hv, SV *keysv, SV *curval) static void S_popdyn(pTHX_ void *_data) { - DynamicVar *dyn = (void *)SvPVX(av_top(dynamicstack)); + AV *stack = dynamicstack; + + DynamicVar *dyn = (void *)SvPVX(av_top(stack)); if(dyn->var != (SV *)_data) croak("ARGH: dynamicstack top mismatch"); - SV *sv = av_pop(dynamicstack); + SV *sv = av_pop(stack); if(dyn->keysv) { HV *hv = ENSURE_HV(dyn->var); @@ -215,8 +217,10 @@ static void S_popdyn(pTHX_ void *_data) static void hook_postsuspend(pTHX_ CV *cv, HV *modhookdata, void *hookdata) { - IV i, max = av_top_index(dynamicstack); - SV **avp = AvARRAY(dynamicstack); + AV *stack = dynamicstack; + + IV i, max = av_top_index(stack); + SV **avp = AvARRAY(stack); int height = PL_savestack_ix; AV *suspendedvars = NULL; @@ -258,7 +262,7 @@ static void hook_postsuspend(pTHX_ CV *cv, HV *modhookdata, void *hookdata) if(i < max) /* truncate */ - av_fill(dynamicstack, i); + av_fill(stack, i); for( ; i >= 0; i--) { DynamicVar *dyn = (void *)SvPVX(avp[i]); @@ -504,8 +508,8 @@ static void enable_async_mode(pTHX_ void *_unused) return; is_async = TRUE; - dynamicstack = newAV(); - av_extend(dynamicstack, 50); + AV *stack = dynamicstack = newAV(); + av_extend(stack, 50); boot_future_asyncawait(0.60); register_future_asyncawait_hook(&faa_hooks, NULL); diff --git a/t/01dynamically.t b/t/01dynamically.t index a37c8b1..5082a99 100644 --- a/t/01dynamically.t +++ b/t/01dynamically.t @@ -114,4 +114,12 @@ subtest "lvalue accessor" => sub { is( $value, "old", 'value restored after block leave' ); }; +{ + no Syntax::Keyword::Dynamically; + + sub dynamically { return "normal function" } + + is( dynamically, "normal function", 'dynamically() parses as a normal function call' ); +} + done_testing; diff --git a/t/80dynamically+Object-Pad.t b/t/80dynamically+Object-Pad.t index 4e49c47..14c637d 100644 --- a/t/80dynamically+Object-Pad.t +++ b/t/80dynamically+Object-Pad.t @@ -8,12 +8,12 @@ use Test2::V0; BEGIN { plan skip_all => "Syntax::Keyword::Dynamically is not available" unless eval { require Syntax::Keyword::Dynamically }; - plan skip_all => "Object::Pad >= 0.73 is not available" + plan skip_all => "Object::Pad >= 0.800 is not available" unless eval { require Object::Pad; - Object::Pad->VERSION( '0.73' ) }; + Object::Pad->VERSION( '0.800' ) }; Syntax::Keyword::Dynamically->import; - Object::Pad->import( ':experimental(init_expr)' ); + Object::Pad->import; diag( "Syntax::Keyword::Dynamically $Syntax::Keyword::Dynamically::VERSION, " . "Object::Pad $Object::Pad::VERSION" ); diff --git a/t/81async-method+dynamically.t b/t/81async-method+dynamically.t index 9ac3a59..2279176 100644 --- a/t/81async-method+dynamically.t +++ b/t/81async-method+dynamically.t @@ -11,15 +11,15 @@ BEGIN { plan skip_all => "Future::AsyncAwait >= 0.40 is not available" unless eval { require Future::AsyncAwait; Future::AsyncAwait->VERSION( '0.40' ) }; - plan skip_all => "Object::Pad >= 0.73 is not available" + plan skip_all => "Object::Pad >= 0.800 is not available" unless eval { require Object::Pad; - Object::Pad->VERSION( '0.73' ) }; + Object::Pad->VERSION( '0.800' ) }; plan skip_all => "Syntax::Keyword::Dynamically >= 0.04 is not available" unless eval { require Syntax::Keyword::Dynamically; Syntax::Keyword::Dynamically->VERSION( '0.04' ) }; Future::AsyncAwait->import; - Object::Pad->import( ':experimental(init_expr)' ); + Object::Pad->import; Syntax::Keyword::Dynamically->import; diag( "Future::AsyncAwait $Future::AsyncAwait::VERSION, " . |