diff options
| author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2020-02-07 10:19:44 +0000 |
|---|---|---|
| committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2020-02-07 10:19:44 +0000 |
| commit | 8f62b02f3875903fe494e2b756356b605d1b3888 (patch) | |
| tree | ce018fa790faab2be9b3d18ad755e63df6c2c056 /dist/Devel-PPPort | |
| parent | 2db5b8da93078342162321482218d65cc5ec5eb5 (diff) | |
| download | perl-8f62b02f3875903fe494e2b756356b605d1b3888.tar.gz | |
Update Devel-PPPort to CPAN version 3.57
[DELTA]
3.57 - 2020-01-31
* Fix eval_sv for Perl versions prior to 5.6.0 (Pali)
* Fix t/ppphtest.t for Perl versions prior to 5.6.0 (Pali)
* Fix compilation of sv_setsv_flags when GCC extensions are not present (Pali)
* Fix SV_NOSTEAL on 5.7.2 (Karl Williamson)
* Fix multiple unit test issues (Craig A. Berry, Karl Williamson, Pali)
* Avoid generating warnings on early Perls (Karl Williamson)
* Backport memCHRs (Karl Williamson)
* Implement sv_setsv_flags() with SV_NOSTEAL and SV_GMAGIC flags for Perl versions < 5.7.3 (Pali)
* Implement UTF8f format and its UTF8fARG macro (Pali)
Diffstat (limited to 'dist/Devel-PPPort')
78 files changed, 920 insertions, 459 deletions
diff --git a/dist/Devel-PPPort/Changes b/dist/Devel-PPPort/Changes index 5aff2bc8da..2c7a164663 100644 --- a/dist/Devel-PPPort/Changes +++ b/dist/Devel-PPPort/Changes @@ -1,5 +1,26 @@ Revision history for Devel-PPPort + 3.57 - 2020-01-31 + + * Fix eval_sv for Perl versions prior to 5.6.0 (Pali) + * Fix t/ppphtest.t for Perl versions prior to 5.6.0 (Pali) + * Fix compilation of sv_setsv_flags when GCC extensions are not present (Pali) + * Fix SV_NOSTEAL on 5.7.2 (Karl Williamson) + * Fix multiple unit test issues (Craig A. Berry, Karl Williamson, Pali) + * Avoid generating warnings on early Perls (Karl Williamson) + * Backport memCHRs (Karl Williamson) + * Implement sv_setsv_flags() with SV_NOSTEAL and SV_GMAGIC flags for Perl versions < 5.7.3 (Pali) + * Implement UTF8f format and its UTF8fARG macro (Pali) + + 3.56 - 2019-11-25 + + * mktests.PL: use FindBin for INC setup + * devel/regenerate: Adjust POD line length + * Fix compilation with Visual C++ bugs introduced in 3.55 (Tomasz Konojacki) + * Fix mess.t failures when on VC++ when $0 contains backslashes (Tomasz Konojacki) + * Fix failing builds on 5.20.[1-3] introduced in 3.55 (Karl Williamson) + * Change tests to accept and use Test::More-like functions (Karl Williamson) + 3.55 - 2019-11-07 * Fix p5-Text-Xslate on Perl 5.8.5 (Nicolas R) diff --git a/dist/Devel-PPPort/Makefile.PL b/dist/Devel-PPPort/Makefile.PL index 266e9b13d2..bc5f502e98 100644 --- a/dist/Devel-PPPort/Makefile.PL +++ b/dist/Devel-PPPort/Makefile.PL @@ -38,13 +38,16 @@ unless ($ENV{'PERL_CORE'}) { @ARGV = map { /^--with-(apicheck)$/ && ++$opt{$1} ? () : $_ } @ARGV; my %mf = ( - NAME => 'Devel::PPPort', - VERSION_FROM => 'PPPort_pm.PL', - PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' }, - H => [ qw(ppport.h) ], - OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)', - XSPROTOARG => '-noprototypes', - CONFIGURE => \&configure, + NAME => 'Devel::PPPort', + VERSION_FROM => 'PPPort_pm.PL', + PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' }, + H => [ qw(ppport.h) ], + OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)', + XSPROTOARG => '-noprototypes', + CONFIGURE => \&configure, + BUILD_REQUIRES => { + "FindBin" => "0", + }, ); WriteMakefile(%mf); diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL index f4f7cf5dc4..f578954c19 100644 --- a/dist/Devel-PPPort/PPPort_pm.PL +++ b/dist/Devel-PPPort/PPPort_pm.PL @@ -711,7 +711,7 @@ package Devel::PPPort; use strict; use vars qw($VERSION $data); -$VERSION = '3.56'; +$VERSION = '3.57'; sub _init_data { diff --git a/dist/Devel-PPPort/TODO b/dist/Devel-PPPort/TODO index a54a8c3e2d..2a26d013f3 100644 --- a/dist/Devel-PPPort/TODO +++ b/dist/Devel-PPPort/TODO @@ -312,7 +312,6 @@ TODO: warn_uninit watchaddr watchok - Xpv Yes * have an --env option for soak to set env variable combinations diff --git a/dist/Devel-PPPort/devel/mkppport_fnc.pl b/dist/Devel-PPPort/devel/mkppport_fnc.pl index d8b9b00f5c..26adfea7f2 100644 --- a/dist/Devel-PPPort/devel/mkppport_fnc.pl +++ b/dist/Devel-PPPort/devel/mkppport_fnc.pl @@ -6,7 +6,7 @@ $Data::Dumper::Sortkeys=1; # # This program should be run when regenerating the data for ppport.h # (devel/regenerate). It should be run after parts/embed.fnc is updated, and -# after mkapidoc.sh has been run. +# after mkapidoc.pl has been run. # # Its purpose is to generate ppport.fnc, a file which has the same syntax as # embed.fnc and apidoc.fnc, but contains entries that should only be tested @@ -151,8 +151,8 @@ print OUT <<EOF; :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: : : This file lists all API functions/macros that are provided purely -: by Devel::PPPort, or that are unXXX It is in the same format as the F<embed.fnc> that -: ships with the Perl source code. +: by Devel::PPPort, or that are not public. It is in the same format as the +: F<embed.fnc> that ships with the Perl source code. : : Since these are used only to provide the argument types, it's ok to have the : return value be void for some where it's an issues diff --git a/dist/Devel-PPPort/devel/regenerate b/dist/Devel-PPPort/devel/regenerate index 2ce5d12378..97b7cbec2b 100755 --- a/dist/Devel-PPPort/devel/regenerate +++ b/dist/Devel-PPPort/devel/regenerate @@ -73,7 +73,7 @@ my %seen; %seen = map { $seen{$_->{name}}++; } @embeds; my @bads = grep { $seen{$_} > 1 } keys %seen; if (@bads) { - print "The following items have multiple entries in the part/*.fnc files.\n", + print "The following items have multiple entries in the parts/*.fnc files.\n", " Regenerate apidoc.fnc, then ppport.fnc and try again. If this\n", " doesn't work, choose the best version for each symbol and delete\n", " the others: ", diff --git a/dist/Devel-PPPort/parts/apidoc.fnc b/dist/Devel-PPPort/parts/apidoc.fnc index ef3dd9e35f..f455038397 100644 --- a/dist/Devel-PPPort/parts/apidoc.fnc +++ b/dist/Devel-PPPort/parts/apidoc.fnc @@ -20,7 +20,6 @@ Amd|void|__ASSERT_|bool expr Amnhd||aTHX Amnhd||aTHX_ Amd|int|AvFILL|AV* av -md|int|AvFILLp|AV* av Amnd|I32|ax Amxud|void|BhkDISABLE|BHK *hk|which Amxud|void|BhkENABLE|BHK *hk|which @@ -32,6 +31,7 @@ AmnUd|const char *|BOM_UTF8 Amd|SV *|boolSV|bool b Amnd||BYTEORDER mxud|void|CALL_BLOCK_HOOKS|which|arg +Amnhd||CALL_CHECKER_REQUIRE_GV Amd|void *|C_ARRAY_END|void *a Amd|STRLEN|C_ARRAY_LENGTH|void *a Amnd||CASTFLAGS @@ -58,6 +58,7 @@ Amxd|SV *|cophh_fetch_pvn|const COPHH *cophh|const char *keypv|STRLEN keylen|U32 Amxd|SV *|cophh_fetch_pvs|const COPHH *cophh|"key"|U32 flags Amxd|SV *|cophh_fetch_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags Amxd|void|cophh_free|COPHH *cophh +Amnhd||COPHH_KEY_UTF8 Amxd|COPHH *|cophh_new_empty Amxd|COPHH *|cophh_store_pv|const COPHH *cophh|const char *key|U32 hash|SV *value|U32 flags Amxd|COPHH *|cophh_store_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags @@ -77,6 +78,7 @@ Amnd||CPPLAST Amnd||CPPMINUS Amnd||CPPRUN Amnd||CPPSTDIN +Amnhd||CV_NAME_NOTQUAL Amxd|PADLIST *|CvPADLIST|CV *cv Amd|HV*|CvSTASH|CV* cv md|bool|CvWEAKOUTSIDE|CV *cv @@ -124,9 +126,14 @@ Amnhd||G_RETHROW AmdR|bool|GROK_NUMERIC_RADIX|NN const char **sp|NN const char *send AmnUd||G_SCALAR Amnhd||GV_ADD +Amnhd||GV_ADDMG +Amnhd||GV_ADDMULTI Amd|AV*|GvAV|GV* gv Amd|CV*|GvCV|GV* gv Amd|HV*|GvHV|GV* gv +Amnhd||GV_NOADD_NOINIT +Amnhd||GV_NOEXPAND +Amnhd||GV_NOINIT AmnUd||G_VOID Amd|HV*|gv_stashpvs|"name"|I32 create Amnhd||GV_SUPER @@ -146,6 +153,7 @@ Amd|STRLEN|HvENAMELEN|HV *stash Amd|unsigned char|HvENAMEUTF8|HV *stash Amd|SV**|hv_fetchs|HV* tb|"key"|I32 lval Amd|STRLEN|HvFILL|HV *const hv +Amnhd||HV_ITERNEXT_WANTPLACEHOLDERS Amd|char*|HvNAME|HV* stash Amd|STRLEN|HvNAMELEN|HV *stash Amd|unsigned char|HvNAMEUTF8|HV *stash @@ -342,7 +350,9 @@ Amnd|I32|ix Amd|U8|LATIN1_TO_NATIVE|U8 ch Amnsd||LEAVE Amsd||LEAVE_with_name|"name" +Amnhd||LEX_KEEP_PREVIOUS Amxd|void|lex_stuff_pvs|"pv"|U32 flags +Amnhd||LEX_STUFF_UTF8 AmUd|bool|LIKELY|const bool expr Amd|OP*|LINKLIST|OP *o Amnd||LONGDBLINFBYTES @@ -352,6 +362,7 @@ Amnd||LONGSIZE Amnd||LSEEKSIZE mnUd||LVRET AmnUd||MARK +Amd|bool|memCHRs|"list"|char c Amd|bool|memEQ|char* s1|char* s2|STRLEN len Amd|bool|memEQs|char* s1|STRLEN l1|"s2" Amd|bool|memNE|char* s1|char* s2|STRLEN len @@ -398,11 +409,14 @@ Amnd||NVSIZE Amnd||NVTYPE Amd|U32|OP_CLASS|OP *o Amd|const char *|OP_DESC|OP *o +Amnhd||OPf_KIDS Amd|bool|OpHAS_SIBLING|OP *o Amd|void|OpLASTSIB_set|OP *o|OP *parent Amd|void|OpMAYBESIB_set|OP *o|OP *sib|OP *parent Amd|void|OpMORESIB_set|OP *o|OP *sib Amd|const char *|OP_NAME|OP *o +Amnhd||OPpEARLY_CV +Amnhd||OPpENTERSUB_AMPER Amd|OP*|OpSIBLING|OP *o Amd|bool|OP_TYPE_IS|OP *o|Optype type Amd|bool|OP_TYPE_IS_OR_WAS|OP *o|Optype type @@ -440,6 +454,7 @@ Amxd|char *|PadnamePV|PADNAME * pn Amxd|SSize_t|PadnameREFCNT|PADNAME * pn Amxd|void|PadnameREFCNT_dec|PADNAME * pn Amxd|SV *|PadnameSV|PADNAME * pn +Amnhd||PADNAMEt_OUTER md|HV *|PadnameTYPE|PADNAME * pn Amxd|bool|PadnameUTF8|PADNAME * pn md|void|PAD_RESTORE_LOCAL|PAD *opad @@ -450,7 +465,12 @@ md|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n md|SV *|PAD_SETSV |PADOFFSET po|SV* sv md|SV *|PAD_SV |PADOFFSET po md|SV *|PAD_SVl |PADOFFSET po +Amnhd||PARSE_OPTIONAL Amd|int|PERL_ABS|int +Amnhd||PERL_EXIT_ABORT +Amnhd||PERL_EXIT_DESTRUCT_END +Amnhd||PERL_EXIT_EXPECTED +Amnhd||PERL_EXIT_WARN Amhd|void|PERL_HASH|U32 hash|char *key|STRLEN klen AmnUd||PERL_INT_MAX AmnUhd||PERL_INT_MIN @@ -478,6 +498,9 @@ ATmhd|int |PerlIO_setpos|PerlIO *f|SV *saved Amhd|int |PerlIO_stdoutf|const char *fmt|... ATmhd|int |PerlIO_ungetc|PerlIO *f|int ch ATmhd|int |PerlIO_vprintf|PerlIO *f|const char *fmt|va_list args +Amnhd||PERL_LOADMOD_DENY +Amnhd||PERL_LOADMOD_IMPORT_OPS +Amnhd||PERL_LOADMOD_NOIMPORT AmnUhd||PERL_LONG_MAX AmnUhd||PERL_LONG_MIN Amnhd||PERL_MAGIC_arylen @@ -566,11 +589,7 @@ AmnxUd|PADNAMELIST *|PL_comppad_name Amnd|COP*|PL_curcop AmnxUd|SV **|PL_curpad Amnd|HV*|PL_curstash -mnd|SV *|PL_DBsingle -mnd|GV *|PL_DBsub -mnd|SV *|PL_DBtrace Amnd|GV *|PL_defgv -mnd|U8|PL_dowarn Amnhd|GV *|PL_errgv Amnd|U8|PL_exit_flags AmnUxd|Perl_keyword_plugin_t|PL_keyword_plugin @@ -586,6 +605,7 @@ AmnxUNd|char *|PL_parser-E<gt>bufptr AmnxUNd|char *|PL_parser-E<gt>linestart Amnd|peep_t|PL_peepp Amnd|signed char|PL_perl_destruct_level +Amnd|enum perl_phase|PL_phase Amnd|peep_t|PL_rpeepp mnd|SV*|PL_rs Amnd|runops_proc_t|PL_runops @@ -636,6 +656,8 @@ AmnUd|const char *|REPLACEMENT_CHARACTER_UTF8 mnd|void|RESTORE_ERRNO Amd|void|RESTORE_LC_NUMERIC Amnd|(whatever)|RETVAL +Amnhd||RV2CVOPCV_MARK_EARLY +Amnhd||RV2CVOPCV_RETURN_NAME_GV Amd|void|Safefree|void* ptr Amd|void|SANE_ERRSV md|void|SAVECLEARSV |SV **svp @@ -672,6 +694,7 @@ AmTRd|NV|Strtol|NN const char * const s|NULLOK char ** e|int base AmTRd|NV|Strtoul|NN const char * const s|NULLOK char ** e|int base Amd|void|StructCopy|type *src|type *dest|type Amud|pair|STR_WITH_LEN|"literal string" +Amnhd||SV_CATBYTES Amd|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len Amd|void|sv_catpv_nomg|SV* sv|const char* ptr Amd|void|sv_catpvs|SV* sv|"literal string" @@ -679,6 +702,7 @@ Amd|void|sv_catpvs_flags|SV* sv|"literal string"|I32 flags Amd|void|sv_catpvs_mg|SV* sv|"literal string" Amd|void|sv_catpvs_nomg|SV* sv|"literal string" Amd|void|sv_catsv_nomg|SV* dsv|SV* ssv +Amnhd||SV_CATUTF8 Amnhd||SV_COW_DROP_PV Amd|STRLEN|SvCUR|SV* sv Amd|void|SvCUR_set|SV* sv|STRLEN len @@ -787,6 +811,7 @@ Amd|void|sv_setsv_nomg|SV* dsv|SV* ssv Amd|void|SvSetSV_nosteal|SV* dsv|SV* ssv Amd|void|SvSHARE|SV* sv Amnhd||SV_SMAGIC +Amnhd||SVs_PADSTALE Amd|HV*|SvSTASH|SV* sv Amd|void|SvSTASH_set|SV* sv|HV* val Amnhd||SVs_TEMP @@ -858,7 +883,14 @@ AmnUd||UNDERBAR AmnUd|UV|UNICODE_REPLACEMENT Amd|UV|UNI_TO_NATIVE|UV ch AmUd|bool|UNLIKELY|const bool expr +Amnhd||UTF8_CHECK_ONLY Amd|STRLEN|UTF8_CHK_SKIP|char* s +Amnhd||UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE +Amnhd||UTF8_DISALLOW_ILLEGAL_INTERCHANGE +Amnhd||UTF8_DISALLOW_NONCHAR +Amnhd||UTF8_DISALLOW_PERL_EXTENDED +Amnhd||UTF8_DISALLOW_SUPER +Amnhd||UTF8_DISALLOW_SURROGATE Amnhd||UTF8f Amhd||UTF8fARG|bool is_utf8|Size_t byte_len|char *str Amd|bool|UTF8_IS_INVARIANT|char c @@ -870,6 +902,12 @@ AmnUd|STRLEN|UTF8_MAXBYTES_CASE Amd|STRLEN|UTF8_SAFE_SKIP|char* s|char* e Amd|STRLEN|UTF8_SKIP|char* s Amd|STRLEN|UTF8SKIP|char* s +Amnhd||UTF8_WARN_ILLEGAL_C9_INTERCHANGE +Amnhd||UTF8_WARN_ILLEGAL_INTERCHANGE +Amnhd||UTF8_WARN_NONCHAR +Amnhd||UTF8_WARN_PERL_EXTENDED +Amnhd||UTF8_WARN_SUPER +Amnhd||UTF8_WARN_SURROGATE Amd|bool|UVCHR_IS_INVARIANT|UV cp Amd|STRLEN|UVCHR_SKIP|UV cp Amnhd||UVof @@ -893,6 +931,7 @@ Amnhd||WARN_EXPERIMENTAL__ALPHA_ASSERTIONS Amnhd||WARN_EXPERIMENTAL__BITWISE Amnhd||WARN_EXPERIMENTAL__CONST_ATTR Amnhd||WARN_EXPERIMENTAL__DECLARED_REFS +Amnhd||WARN_EXPERIMENTAL__ISA Amnhd||WARN_EXPERIMENTAL__LEXICAL_SUBS Amnhd||WARN_EXPERIMENTAL__POSTDEREF Amnhd||WARN_EXPERIMENTAL__PRIVATE_USE diff --git a/dist/Devel-PPPort/parts/base/5003007 b/dist/Devel-PPPort/parts/base/5003007 index f3d3468f8d..11fdae8f64 100644 --- a/dist/Devel-PPPort/parts/base/5003007 +++ b/dist/Devel-PPPort/parts/base/5003007 @@ -54,6 +54,7 @@ gp_free # T gp_ref # T G_SCALAR # T GV_ADD # T +GV_ADDMULTI # T GvAV # T gv_AVadd # T gv_check # T @@ -172,7 +173,9 @@ Nullch # T Nullcv # T Nullhv # T Nullsv # T +OPf_KIDS # T op_free # T +OPpENTERSUB_AMPER # T ORIGMARK # T OSNAME # T pad_alloc # T diff --git a/dist/Devel-PPPort/parts/base/5004005 b/dist/Devel-PPPort/parts/base/5004005 index d1fcadd651..5abbf160cd 100644 --- a/dist/Devel-PPPort/parts/base/5004005 +++ b/dist/Devel-PPPort/parts/base/5004005 @@ -2,6 +2,7 @@ do_binmode # E dTHR # E ERRSV # E +GV_NOINIT # E newCONSTSUB # E newSVpvn # E PL_curcop # E diff --git a/dist/Devel-PPPort/parts/base/5005000 b/dist/Devel-PPPort/parts/base/5005000 index 19141f84c0..a9d989f6e7 100644 --- a/dist/Devel-PPPort/parts/base/5005000 +++ b/dist/Devel-PPPort/parts/base/5005000 @@ -38,6 +38,7 @@ PL_laststatval # M added by devel/scanprov PL_mess_sv # M added by devel/scanprov PL_statcache # M added by devel/scanprov PL_Sv # M added by devel/scanprov +PL_Xpv # M added by devel/scanprov START_EXTERN_C # M added by devel/scanprov add_data # F added by devel/scanprov ao # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5006000 b/dist/Devel-PPPort/parts/base/5006000 index e0274ab609..268579a25d 100644 --- a/dist/Devel-PPPort/parts/base/5006000 +++ b/dist/Devel-PPPort/parts/base/5006000 @@ -82,8 +82,13 @@ newXS # E (Perl_newXS) newXSproto # E NVTYPE # E op_dump # E +OPpEARLY_CV # E +PERL_EXIT_EXPECTED # E PerlIO_printf # E PerlIO_stdoutf # E +PERL_LOADMOD_DENY # E +PERL_LOADMOD_IMPORT_OPS # E +PERL_LOADMOD_NOIMPORT # E perl_parse # E (perl_parse) PERL_REVISION # E PERL_SUBVERSION # E @@ -126,6 +131,7 @@ sv_2pvutf8 # U sv_2pvutf8_nolen # U sv_catpvf # E (Perl_sv_catpvf) sv_catpvf_mg # E (Perl_sv_catpvf_mg) +SVf # E sv_force_normal # U SVf_UTF8 # E SvIOK_notUV # E @@ -266,7 +272,6 @@ PL_ppaddr # M added by devel/scanprov pTHX_ # M added by devel/scanprov PTRV # M added by devel/scanprov sv_catpvf_mg_nocontext # M added by devel/scanprov -SVf # M added by devel/scanprov sv_setpvf_mg_nocontext # M added by devel/scanprov warn_nocontext # M added by devel/scanprov XSprePUSH # M added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5007001 b/dist/Devel-PPPort/parts/base/5007001 index 021df16819..14a9a2763f 100644 --- a/dist/Devel-PPPort/parts/base/5007001 +++ b/dist/Devel-PPPort/parts/base/5007001 @@ -33,6 +33,7 @@ SvUOK # U sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) UNICODE_REPLACEMENT # E UNI_TO_NATIVE # U +UTF8_CHECK_ONLY # E UTF8_IS_INVARIANT # U utf8_length # U utf8n_to_uvchr # U diff --git a/dist/Devel-PPPort/parts/base/5007003 b/dist/Devel-PPPort/parts/base/5007003 index 1e5ec2d2b1..6360b28a08 100644 --- a/dist/Devel-PPPort/parts/base/5007003 +++ b/dist/Devel-PPPort/parts/base/5007003 @@ -25,6 +25,7 @@ my_socketpair # U OP_DESC # U OP_NAME # U perl_destruct # E (perl_destruct) +PERL_EXIT_DESTRUCT_END # E PerlIO_clearerr # U (PerlIO_clearerr) PerlIO_close # U (PerlIO_close) PerlIO_eof # U (PerlIO_eof) diff --git a/dist/Devel-PPPort/parts/base/5008000 b/dist/Devel-PPPort/parts/base/5008000 index 28ee45dbb5..53b76869c1 100644 --- a/dist/Devel-PPPort/parts/base/5008000 +++ b/dist/Devel-PPPort/parts/base/5008000 @@ -1,5 +1,6 @@ 5.008000 hv_iternext_flags # U +HV_ITERNEXT_WANTPLACEHOLDERS # E hv_store_flags # U nothreadhook # U Poison # E diff --git a/dist/Devel-PPPort/parts/base/5009000 b/dist/Devel-PPPort/parts/base/5009000 index 0f681b7efc..e33d67e48d 100644 --- a/dist/Devel-PPPort/parts/base/5009000 +++ b/dist/Devel-PPPort/parts/base/5009000 @@ -12,6 +12,7 @@ parser_dup # E pMY_CXT # E regdupe_internal # U save_set_svflags # U +SVs_PADSTALE # E vcmp # U vnumify # U vstringify # U diff --git a/dist/Devel-PPPort/parts/base/5009003 b/dist/Devel-PPPort/parts/base/5009003 index 0464dbf1de..69b81a2ffb 100644 --- a/dist/Devel-PPPort/parts/base/5009003 +++ b/dist/Devel-PPPort/parts/base/5009003 @@ -7,6 +7,8 @@ dMULTICALL # E doref # U dVAR # E gv_const_sv # U +GV_NOADD_NOINIT # E +GV_NOEXPAND # E gv_stashpvs # U hv_eiter_p # U hv_eiter_set # U diff --git a/dist/Devel-PPPort/parts/base/5009005 b/dist/Devel-PPPort/parts/base/5009005 index f06b4ad6e3..17ce3d58c7 100644 --- a/dist/Devel-PPPort/parts/base/5009005 +++ b/dist/Devel-PPPort/parts/base/5009005 @@ -31,12 +31,12 @@ reg_named_buff_nextkey # U reg_named_buff_scalar # U savesharedpvn # U scan_vstring # E (Perl_scan_vstring) +SVfARG # U SvRX # U SvRXOK # U upg_version # E (Perl_upg_version) GV_NOADD_MASK # M added by devel/scanprov SV_COW_SHARED_HASH_KEYS # M added by devel/scanprov -SVfARG # M added by devel/scanprov boot_core_mro # F added by devel/scanprov find_and_forget_pmops # F added by devel/scanprov mro_get_linear_isa_dfs # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5011002 b/dist/Devel-PPPort/parts/base/5011002 index 447639ed7a..651df59250 100644 --- a/dist/Devel-PPPort/parts/base/5011002 +++ b/dist/Devel-PPPort/parts/base/5011002 @@ -5,6 +5,7 @@ LEAVE_with_name # U lex_bufutf8 # U lex_discard_to # U lex_grow_linestr # U +LEX_KEEP_PREVIOUS # E lex_next_chunk # U lex_peek_unichar # U lex_read_space # U @@ -12,6 +13,7 @@ lex_read_to # U lex_read_unichar # U lex_stuff_pvn # U lex_stuff_sv # U +LEX_STUFF_UTF8 # E lex_unstuff # U PL_keyword_plugin # E gv_try_downgrade # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5013006 b/dist/Devel-PPPort/parts/base/5013006 index 4d4f46457d..0ee7d59b9e 100644 --- a/dist/Devel-PPPort/parts/base/5013006 +++ b/dist/Devel-PPPort/parts/base/5013006 @@ -50,6 +50,8 @@ op_prepend_elem # U parse_stmtseq # U PERL_MAGIC_checkcall # E rv2cv_op_cv # U +RV2CVOPCV_MARK_EARLY # E +RV2CVOPCV_RETURN_NAME_GV # E savesharedpvs # U savesharedsvpv # U sv_2bool_flags # U diff --git a/dist/Devel-PPPort/parts/base/5013007 b/dist/Devel-PPPort/parts/base/5013007 index fb14bc9fd1..50f21faf62 100644 --- a/dist/Devel-PPPort/parts/base/5013007 +++ b/dist/Devel-PPPort/parts/base/5013007 @@ -12,6 +12,7 @@ cophh_fetch_pvn # E cophh_fetch_pvs # E cophh_fetch_sv # E cophh_free # E +COPHH_KEY_UTF8 # E cophh_new_empty # E cophh_store_pv # E cophh_store_pvn # E @@ -33,6 +34,8 @@ op_scope # U parse_barestmt # U parse_block # U parse_label # U +PARSE_OPTIONAL # E +PL_phase # E SvPV_nomg_nolen # U XopFLAGS # E XopDISABLE # M added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5013009 b/dist/Devel-PPPort/parts/base/5013009 index 5a2f5e94d5..c969c702a9 100644 --- a/dist/Devel-PPPort/parts/base/5013009 +++ b/dist/Devel-PPPort/parts/base/5013009 @@ -1,5 +1,13 @@ 5.013009 PERL_PV_ESCAPE_NONASCII # E +UTF8_DISALLOW_ILLEGAL_INTERCHANGE # E +UTF8_DISALLOW_NONCHAR # E +UTF8_DISALLOW_SUPER # E +UTF8_DISALLOW_SURROGATE # E +UTF8_WARN_ILLEGAL_INTERCHANGE # E +UTF8_WARN_NONCHAR # E +UTF8_WARN_SUPER # E +UTF8_WARN_SURROGATE # E check_utf8_print # F added by devel/scanprov curse # F added by devel/scanprov report_wrongway_fh # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5015003 b/dist/Devel-PPPort/parts/base/5015003 index 5ed19f8dbd..c10cb56bdd 100644 --- a/dist/Devel-PPPort/parts/base/5015003 +++ b/dist/Devel-PPPort/parts/base/5015003 @@ -1,4 +1,5 @@ 5.015003 +GV_ADDMG # E coresub_op # F added by devel/scanprov inplace_aassign # F added by devel/scanprov op_integerize # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5017008 b/dist/Devel-PPPort/parts/base/5017008 index 8a67272996..1f573e92ea 100644 --- a/dist/Devel-PPPort/parts/base/5017008 +++ b/dist/Devel-PPPort/parts/base/5017008 @@ -11,7 +11,6 @@ isIDCONT_LC # U isIDCONT_LC_uvchr # U WARN_EXPERIMENTAL__REGEX_SETS # E croak_popstack # F added by devel/scanprov -form_short_octal_warning # F added by devel/scanprov invlist_is_iterating # F added by devel/scanprov invlist_iterfinish # F added by devel/scanprov isFOO_utf8_lc # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5019003 b/dist/Devel-PPPort/parts/base/5019003 index 6a1a3b8d9f..5bcd299ae5 100644 --- a/dist/Devel-PPPort/parts/base/5019003 +++ b/dist/Devel-PPPort/parts/base/5019003 @@ -1,4 +1,6 @@ 5.019003 +PERL_EXIT_ABORT # E +PERL_EXIT_WARN # E sv_pos_b2u_flags # U adjust_size_and_find_bucket # F added by devel/scanprov cv_const_sv_or_av # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5021004 b/dist/Devel-PPPort/parts/base/5021004 index 7bb17352e8..05a1b650a6 100644 --- a/dist/Devel-PPPort/parts/base/5021004 +++ b/dist/Devel-PPPort/parts/base/5021004 @@ -1,4 +1,5 @@ 5.021004 +CALL_CHECKER_REQUIRE_GV # E cv_set_call_checker_flags # U grok_infnan # U isinfnan # U diff --git a/dist/Devel-PPPort/parts/base/5021005 b/dist/Devel-PPPort/parts/base/5021005 index bc63e4ac62..a4270833c2 100644 --- a/dist/Devel-PPPort/parts/base/5021005 +++ b/dist/Devel-PPPort/parts/base/5021005 @@ -1,9 +1,12 @@ 5.021005 cv_name # A +CV_NAME_NOTQUAL # E newMETHOP # U newMETHOP_named # U PERL_MAGIC_debugvar # E PERL_MAGIC_lvref # E +SV_CATBYTES # E +SV_CATUTF8 # E WARN_EXPERIMENTAL__REFALIASING # E assignment_type # F added by devel/scanprov gv_setref # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5021007 b/dist/Devel-PPPort/parts/base/5021007 index 99b2ac8efe..4a3d4d0bbc 100644 --- a/dist/Devel-PPPort/parts/base/5021007 +++ b/dist/Devel-PPPort/parts/base/5021007 @@ -12,6 +12,7 @@ PadnamelistREFCNT_dec # U padnamelist_store # U PadnameREFCNT # U PadnameREFCNT_dec # U +PADNAMEt_OUTER # E gv_fetchmeth_internal # F added by devel/scanprov opmethod_stash # F added by devel/scanprov pad_add_weakref # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5025005 b/dist/Devel-PPPort/parts/base/5025005 index 37064be6ca..7b018cecff 100644 --- a/dist/Devel-PPPort/parts/base/5025005 +++ b/dist/Devel-PPPort/parts/base/5025005 @@ -7,5 +7,7 @@ is_utf8_invariant_string # U is_utf8_valid_partial_char # U is_utf8_valid_partial_char_flags # U REPLACEMENT_CHARACTER_UTF8 # E +UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE # E +UTF8_WARN_ILLEGAL_C9_INTERCHANGE # E delimcpy_no_escape # F added by devel/scanprov is_utf8_cp_above_31_bits # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5025009 b/dist/Devel-PPPort/parts/base/5025009 index 6a7c035a5d..71d2ac4a62 100644 --- a/dist/Devel-PPPort/parts/base/5025009 +++ b/dist/Devel-PPPort/parts/base/5025009 @@ -38,5 +38,4 @@ toLOWER_utf8_safe # U toTITLE_utf8_safe # U toUPPER_utf8_safe # U _force_out_malformed_utf8_message # F added by devel/scanprov -_is_grapheme # F added by devel/scanprov warn_on_first_deprecated_use # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5027002 b/dist/Devel-PPPort/parts/base/5027002 index 6d60bc573b..2ba94f4bbc 100644 --- a/dist/Devel-PPPort/parts/base/5027002 +++ b/dist/Devel-PPPort/parts/base/5027002 @@ -1,5 +1,7 @@ 5.027002 Perl_setlocale # U +UTF8_DISALLOW_PERL_EXTENDED # E +UTF8_WARN_PERL_EXTENDED # E hv_free_entries # F added by devel/scanprov print_bytes_for_locale # F added by devel/scanprov setlocale_debug_string # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5031002 b/dist/Devel-PPPort/parts/base/5031002 index 6fe7957892..7a56370973 100644 --- a/dist/Devel-PPPort/parts/base/5031002 +++ b/dist/Devel-PPPort/parts/base/5031002 @@ -1,2 +1,3 @@ 5.031002 +G_RETHROW # E Perl_my_mkostemp_cloexec # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5031007 b/dist/Devel-PPPort/parts/base/5031007 index e24cbe34e1..b0206dce34 100644 --- a/dist/Devel-PPPort/parts/base/5031007 +++ b/dist/Devel-PPPort/parts/base/5031007 @@ -3,8 +3,11 @@ csighandler # E (Perl_csighandler) csighandler1 # U csighandler3 # E perly_sighandler # E +sv_isa_sv # U +WARN_EXPERIMENTAL__ISA # E find_first_differing_byte_pos # F added by devel/scanprov invlist_lowest # F added by devel/scanprov +is_grapheme # F added by devel/scanprov quadmath_format_valid # F added by devel/scanprov sighandler1 # F added by devel/scanprov sighandler3 # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5031008 b/dist/Devel-PPPort/parts/base/5031008 new file mode 100644 index 0000000000..7424595b83 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5031008 @@ -0,0 +1,4 @@ +5.031008 +memCHRs # U +grok_bin_oct_hex # F added by devel/scanprov +output_non_portable # F added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/embed.fnc b/dist/Devel-PPPort/parts/embed.fnc index 3a75a4cd1f..4bb864f122 100644 --- a/dist/Devel-PPPort/parts/embed.fnc +++ b/dist/Devel-PPPort/parts/embed.fnc @@ -91,7 +91,7 @@ : The E flag is used instead for a function and its short name that is supposed : to be used only in the core, and in extensions compiled with the : PERL_EXT symbol defined. Again, on some platforms, the function -: will be visible everywhere, so the 'p' flag is gnerally needed. +: will be visible everywhere, so the 'p' flag is generally needed. : Also note that an XS writer can always cheat and pretend to be an : extension by #defining PERL_EXT. : @@ -785,6 +785,7 @@ p |void |dump_sub_perl |NN const GV* gv|bool justperl Apd |void |fbm_compile |NN SV* sv|U32 flags ApdR |char* |fbm_instr |NN unsigned char* big|NN unsigned char* bigend \ |NN SV* littlestr|U32 flags +pEXTR |const char *|cntrl_to_mnemonic|const U8 c p |CV * |find_lexical_cv|PADOFFSET off : Defined in util.c, used only in perl.c p |char* |find_script |NN const char *scriptname|bool dosearch \ @@ -1135,35 +1136,60 @@ Ap |void |vload_module|U32 flags|NN SV* name|NULLOK SV* ver|NULLOK va_list* args : Used in perly.y p |OP* |localize |NN OP *o|I32 lex ApdR |I32 |looks_like_number|NN SV *const sv -Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_DQUOTE_C) -EpRX |bool |grok_bslash_x |NN char** s \ - |NN const char* const send \ - |NN UV* uv \ - |NN const char** error_msg \ - |const bool output_warning \ - |const bool strict \ - |const bool silence_non_portable \ +EpRX |bool |grok_bslash_x |NN char** s \ + |NN const char* const send \ + |NN UV* uv \ + |NN const char** message \ + |NULLOK U32 * packed_warn \ + |const bool strict \ + |const bool allow_UV_MAX \ |const bool utf8 -EpRX |char |grok_bslash_c |const char source|const bool output_warning -EpRX |bool |grok_bslash_o |NN char** s \ - |NN const char* const send \ - |NN UV* uv \ - |NN const char** error_msg \ - |const bool output_warning \ - |const bool strict \ - |const bool silence_non_portable \ +EpRX |bool |grok_bslash_c |const char source \ + |NN U8 * result \ + |NN const char** message \ + |NULLOK U32 * packed_warn +EpRX |bool |grok_bslash_o |NN char** s \ + |NN const char* const send \ + |NN UV* uv \ + |NN const char** message \ + |NULLOK U32 * packed_warn \ + |const bool strict \ + |const bool allow_UV_MAX \ |const bool utf8 -EiR |char*|form_short_octal_warning|NN const char * const s \ - |const STRLEN len -EiRT |I32 |regcurly |NN const char *s -#endif -Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +EpRX |const char *|form_alien_digit_msg|const U8 which \ + |const STRLEN valids_len \ + |NN const char * const first_bad\ + |NN const char * const send \ + |const bool UTF \ + |const bool braced +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) +EiRT |bool |regcurly |NN const char *s +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_DQUOTE_C) || defined(PERL_IN_UTF8_C) +EpRX |const char *|form_cp_too_large_msg|const U8 which \ + |NULLOK const char * string \ + |const Size_t len \ + |const UV cp +#endif +AMpd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result Apd |int |grok_infnan |NN const char** sp|NN const char *send Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep Apd |int |grok_number_flags|NN const char *pv|STRLEN len|NULLOK UV *valuep|U32 flags ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send -Apd |UV |grok_oct |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +ApMd |UV |grok_oct |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +ApMd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +Cp |UV |grok_bin_oct_hex|NN const char* start \ + |NN STRLEN* len_p \ + |NN I32* flags \ + |NULLOK NV *result \ + |const unsigned shift \ + |const U8 lookup_bit \ + |const char prefix +#ifdef PERL_IN_NUMERIC_C +S |void |output_non_portable|const U8 shift +#endif EXpdT |bool |grok_atoUV |NN const char* pv|NN UV* valptr|NULLOK const char** endptr : These are all indirectly referenced by globals.c. This is somewhat annoying. p |int |magic_clearenv |NN SV* sv|NN MAGIC* mg @@ -1595,7 +1621,7 @@ p |void |rxres_save |NN void **rsp|NN REGEXP *rx p |I32 |same_dirent |NN const char* a|NN const char* b #endif Apda |char* |savepv |NULLOK const char* pv -Apda |char* |savepvn |NULLOK const char* pv|I32 len +Apda |char* |savepvn |NULLOK const char* pv|Size_t len Apda |char* |savesharedpv |NULLOK const char* pv : NULLOK only to suppress a compiler warning @@ -1777,6 +1803,7 @@ ApdR |bool |sv_derived_from_sv|NN SV* sv|NN SV *namesv|U32 flags ApdR |bool |sv_derived_from_pv|NN SV* sv|NN const char *const name|U32 flags ApdR |bool |sv_derived_from_pvn|NN SV* sv|NN const char *const name \ |const STRLEN len|U32 flags +ApdRx |bool |sv_isa_sv |NN SV* sv|NN SV* namesv ApdR |bool |sv_does |NN SV* sv|NN const char *const name ApdR |bool |sv_does_sv |NN SV* sv|NN SV* namesv|U32 flags ApdR |bool |sv_does_pv |NN SV* sv|NN const char *const name|U32 flags @@ -1878,6 +1905,8 @@ EiR |SV* |add_cp_to_invlist |NULLOK SV* invlist|const UV cp Ei |void |invlist_extend |NN SV* const invlist|const UV len Ei |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset EiRT |UV |invlist_highest|NN SV* const invlist +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_OP_C) EiRT |STRLEN*|get_invlist_iter_addr |NN SV* invlist EiT |void |invlist_iterinit|NN SV* invlist EiRT |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end @@ -1983,8 +2012,8 @@ S |UV |_to_utf8_case |const UV uv1 \ |NN U8* ustrp \ |NN STRLEN *lenp \ |NN SV *invlist \ - |NN const int * const invmap \ - |NULLOK const unsigned int * const * const aux_tables \ + |NN const I32 * const invmap \ + |NULLOK const U32 * const * const aux_tables \ |NULLOK const U8 * const aux_table_lengths \ |NN const char * const normal S |UV |turkic_fc |NN const U8 * const p |NN const U8 * const e|NN U8* ustrp|NN STRLEN *lenp @@ -2021,8 +2050,8 @@ p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* a Cp |void |_force_out_malformed_utf8_message \ |NN const U8 *const p|NN const U8 * const e|const U32 flags \ |const bool die_here -EXp |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen -EXp |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen +EXp |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|Size_t bytelen|NN Size_t *newlen +EXp |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|Size_t bytelen|NN Size_t *newlen AdpR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e AipdR |IV |utf8_distance |NN const U8 *a|NN const U8 *b AipdRT |U8* |utf8_hop |NN const U8 *s|SSize_t off @@ -2081,8 +2110,8 @@ Cdp |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |char* |pv_uni_display |NN SV *dsv|NN const U8 *spv|STRLEN len|STRLEN pvlim|UV flags ApdR |char* |sv_uni_display |NN SV *dsv|NN SV *ssv|STRLEN pvlim|UV flags EXpR |Size_t |_inverse_folds |const UV cp \ - |NN unsigned int * first_folds_to \ - |NN const unsigned int ** remaining_folds_to + |NN U32 * first_folds_to \ + |NN const U32 ** remaining_folds_to : Used by Data::Alias EXp |void |vivify_defelem |NN SV* sv : Used in pp.c @@ -2686,14 +2715,13 @@ ES |I32 |make_trie |NN RExC_state_t *pRExC_state \ |U32 word_count|U32 flags|U32 depth ES |regnode *|construct_ahocorasick_from_trie|NN RExC_state_t *pRExC_state \ |NN regnode *source|U32 depth -ETSR |const char *|cntrl_to_mnemonic|const U8 c ETSR |int |edit_distance |NN const UV *src \ |NN const UV *tgt \ |const STRLEN x \ |const STRLEN y \ |const SSize_t maxDistance EpX |SV * |parse_uniprop_string|NN const char * const name \ - |const Size_t name_len \ + |Size_t name_len \ |const bool is_utf8 \ |const bool to_fold \ |const bool runtime \ @@ -2758,8 +2786,8 @@ ESR |bool |regtail_study |NN RExC_state_t *pRExC_state \ EXRp |bool |isFOO_lc |const U8 classnum|const U8 character #endif -#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) -ERp |bool |_is_grapheme |NN const U8 * strbeg|NN const U8 * s|NN const U8 *strend|const UV cp +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) +ERp |bool |is_grapheme |NN const U8 * strbeg|NN const U8 * s|NN const U8 *strend|const UV cp #endif #if defined(PERL_IN_REGEXEC_C) @@ -3353,7 +3381,7 @@ ApTd |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t siz #endif #ifndef HAS_STRNLEN -ApTd |Size_t |my_strnlen |NN const char *str|Size_t maxlen +AipTd |Size_t |my_strnlen |NN const char *str|Size_t maxlen #endif #ifndef HAS_MKOSTEMP @@ -3364,7 +3392,7 @@ pTo |int |my_mkstemp |NN char *templte #endif APpdT |bool |isinfnan |NV nv -p |bool |isinfnansv |NN SV *sv +pd |bool |isinfnansv |NN SV *sv #if !defined(HAS_SIGNBIT) AxdToP |int |Perl_signbit |NV f diff --git a/dist/Devel-PPPort/parts/inc/SvPV b/dist/Devel-PPPort/parts/inc/SvPV index 592f999e56..c20cb85876 100644 --- a/dist/Devel-PPPort/parts/inc/SvPV +++ b/dist/Devel-PPPort/parts/inc/SvPV @@ -82,11 +82,12 @@ __UNDEFINED__ SV_SMAGIC 0 __UNDEFINED__ SV_HAS_TRAILING_NUL 0 __UNDEFINED__ SV_COW_SHARED_HASH_KEYS 0 -#if { VERSION < 5.7.2 } - -__UNDEFINED__ sv_2pv_flags(sv, lp, flags) sv_2pv((sv), (lp) ? (lp) : &PL_na) -__UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) sv_pvn_force((sv), (lp) ? (lp) : &PL_na) - +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) + __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_2pv(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_2pv(_sv, _lp); }) + __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ({ SV *_sv = (sv); const I32 _flags = (flags); STRLEN *_lp = lp; _lp = _lp ? : &PL_na; (!(_flags & SV_GMAGIC) && SvGMAGICAL(_sv)) ? ({ char *_pv; SvGMAGICAL_off(_sv); _pv = sv_pvn_force(_sv, _lp); SvGMAGICAL_on(_sv); _pv; }) : sv_pvn_force(_sv, _lp); }) +#else + __UNDEFINED__ sv_2pv_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_2pv(PL_Sv, (lp) ? (lp) : &PL_na)) + __UNDEFINED__ sv_pvn_force_flags(sv, lp, flags) ((PL_Sv = (sv)), (!((flags) & SV_GMAGIC) && SvGMAGICAL(PL_Sv)) ? (SvGMAGICAL_off(PL_Sv), (PL_Xpv = (XPV *)sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)), SvGMAGICAL_on(PL_Sv), (char *)PL_Xpv) : sv_pvn_force(PL_Sv, (lp) ? (lp) : &PL_na)) #endif #if { VERSION < 5.8.8 } || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.3 } ) diff --git a/dist/Devel-PPPort/parts/inc/Sv_set b/dist/Devel-PPPort/parts/inc/Sv_set index e8dfe23442..8c3f91b797 100644 --- a/dist/Devel-PPPort/parts/inc/Sv_set +++ b/dist/Devel-PPPort/parts/inc/Sv_set @@ -16,15 +16,13 @@ SV_NOSTEAL sv_setsv_flags newSVsv_nomg -=dontwarn - -sv_setsv_flags - =implementation +__UNDEFINED__ SV_NOSTEAL 16 + #if ( { VERSION >= 5.7.3 } && { VERSION < 5.8.7 } ) || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.2 } ) #undef sv_setsv_flags -#define SV_NOSTEAL 16 +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) #define sv_setsv_flags(dstr, sstr, flags) \ STMT_START { \ if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \ @@ -35,6 +33,72 @@ sv_setsv_flags Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL); \ } \ } STMT_END +#else + ( \ + (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? ( \ + SvTEMP_off((SV *)(sstr)), \ + Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL), \ + SvTEMP_on((SV *)(sstr)), \ + 1 \ + ) : ( \ + Perl_sv_setsv_flags(aTHX_ (dstr), (sstr), (flags) & ~SV_NOSTEAL), \ + 1 \ + ) \ + ) +#endif +#endif + +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +__UNDEFINED__ sv_setsv_flags(dstr, sstr, flags) \ + STMT_START { \ + if (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) { \ + SvTEMP_off((SV *)(sstr)); \ + if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) { \ + SvGMAGICAL_off((SV *)(sstr)); \ + sv_setsv((dstr), (sstr)); \ + SvGMAGICAL_on((SV *)(sstr)); \ + } else { \ + sv_setsv((dstr), (sstr)); \ + } \ + SvTEMP_on((SV *)(sstr)); \ + } else { \ + if (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) { \ + SvGMAGICAL_off((SV *)(sstr)); \ + sv_setsv((dstr), (sstr)); \ + SvGMAGICAL_on((SV *)(sstr)); \ + } else { \ + sv_setsv((dstr), (sstr)); \ + } \ + } \ + } STMT_END +#else +__UNDEFINED__ sv_setsv_flags(dstr, sstr, flags) \ + ( \ + (((flags) & SV_NOSTEAL) && (sstr) && (SvFLAGS((SV *)(sstr)) & SVs_TEMP)) ? ( \ + SvTEMP_off((SV *)(sstr)), \ + (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? ( \ + SvGMAGICAL_off((SV *)(sstr)), \ + sv_setsv((dstr), (sstr)), \ + SvGMAGICAL_on((SV *)(sstr)), \ + 1 \ + ) : ( \ + sv_setsv((dstr), (sstr)), \ + 1 \ + ), \ + SvTEMP_on((SV *)(sstr)), \ + 1 \ + ) : ( \ + (!((flags) & SV_GMAGIC) && (sstr) && SvGMAGICAL((SV *)(sstr))) ? ( \ + SvGMAGICAL_off((SV *)(sstr)), \ + sv_setsv((dstr), (sstr)), \ + SvGMAGICAL_on((SV *)(sstr)), \ + 1 \ + ) : ( \ + sv_setsv((dstr), (sstr)), \ + 1 \ + ) \ + ) \ + ) #endif #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) @@ -43,9 +107,7 @@ __UNDEFINED__ newSVsv_flags(sv, flags) ({ SV *_sv = newSV(0); sv_setsv_flags(_sv __UNDEFINED__ newSVsv_flags(sv, flags) ((PL_Sv = newSV(0)), sv_setsv_flags(PL_Sv, (sv), (flags)), PL_Sv) #endif -#ifdef SV_NOSTEAL __UNDEFINED__ newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL) -#endif #if { VERSION >= 5.17.5 } __UNDEFINED__ sv_mortalcopy_flags(sv, flags) Perl_sv_mortalcopy_flags(aTHX_ (sv), (flags)) @@ -132,8 +194,6 @@ TestSvSTASH_set(sv, name) SvREFCNT_dec(SvSTASH(sv)); SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); -#ifdef SV_NOSTEAL - IV Test_sv_setsv_SV_NOSTEAL() PREINIT: @@ -146,10 +206,6 @@ Test_sv_setsv_SV_NOSTEAL() OUTPUT: RETVAL -#endif - -#ifdef newSVsv_nomg - SV * newSVsv_nomg(sv) SV *sv @@ -158,19 +214,13 @@ newSVsv_nomg(sv) OUTPUT: RETVAL -#endif - void sv_setsv_compile_test(sv) SV *sv CODE: sv_setsv(sv, NULL); -#ifdef sv_setsv_flags sv_setsv_flags(sv, NULL, 0); -#ifdef SV_NOSTEAL sv_setsv_flags(sv, NULL, SV_NOSTEAL); -#endif -#endif =tests plan => 15 @@ -187,10 +237,12 @@ is($bar->x(), 'foobar'); Devel::PPPort::TestSvSTASH_set($bar, 'bar'); is($bar->x(), 'hacker'); -if ( "$]" < '5.007003' ) { - skip 'skip: no SV_NOSTEAL support', 10; -} else { - ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL()); + if (ivers($]) != ivers(5.7.2)) { + ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL()); + } + else { + skip("7.2 broken for NOSTEAL", 1); + } tie my $scalar, 'TieScalarCounter', 'string'; @@ -207,7 +259,6 @@ if ( "$]" < '5.007003' ) { is tied($scalar)->{fetch}, 1; is tied($scalar)->{store}, 0; is $copy2, 'string'; -} package TieScalarCounter; diff --git a/dist/Devel-PPPort/parts/inc/call b/dist/Devel-PPPort/parts/inc/call index 3daf589f47..35258549f8 100644 --- a/dist/Devel-PPPort/parts/inc/call +++ b/dist/Devel-PPPort/parts/inc/call @@ -29,10 +29,19 @@ __UNDEFINED__ call_sv perl_call_sv __UNDEFINED__ call_pv perl_call_pv __UNDEFINED__ call_argv perl_call_argv __UNDEFINED__ call_method perl_call_method - __UNDEFINED__ eval_sv perl_eval_sv +#if { VERSION >= 5.3.98 } && { VERSION < 5.6.0 } +__UNDEFINED__ eval_pv perl_eval_pv +#endif /* Replace: 0 */ +#if { VERSION < 5.6.0 } +__UNDEFINED__ Perl_eval_sv perl_eval_sv +#if { VERSION >= 5.3.98 } +__UNDEFINED__ Perl_eval_pv perl_eval_pv +#endif +#endif + __UNDEFINED__ PERL_LOADMOD_DENY 0x1 __UNDEFINED__ PERL_LOADMOD_NOIMPORT 0x2 __UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 @@ -81,8 +90,7 @@ __UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 # endif #endif -/* Replace perl_eval_pv with eval_pv */ - +/* This is backport for Perl 5.3.97d and older which do not provide perl_eval_pv */ #ifndef eval_pv #if { NEED eval_pv } @@ -336,7 +344,7 @@ load_module(flags, name, version, ...) Perl_load_module(aTHX_ flags, SvREFCNT_inc_simple(name), SvREFCNT_inc_simple(version), NULL); -=tests plan => 86 +=tests plan => 88 sub f { @@ -399,6 +407,7 @@ ok(eval { $@ = 'string1'; Devel::PPPort::eval_pv('$@ = "string2"', 1); 1 }); ok(eval { $@ = 'string1'; Devel::PPPort::eval_pv('$@ = "string2"; die "string3"', 0); 1 }); ok(!eval { $@ = 'string1'; Devel::PPPort::eval_pv('$@ = "string2"; die "string3"', 1); 1 }); ok($@ =~ /^string3 at \(eval [0-9]+\) line 1\.\n$/); +ok(!eval { Devel::PPPort::eval_pv('die False->new', 1); 1 }, 'check false value is rethrown'); if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) { my $hashref = { key => 'value' }; @@ -425,6 +434,7 @@ ok(eval { $@ = 'string1'; Devel::PPPort::eval_sv('$@ = "string2"', &Devel::PPPor ok(eval { $@ = 'string1'; Devel::PPPort::eval_sv('$@ = "string2"; die "string3"', 0); 1 }); ok(!eval { $@ = 'string1'; Devel::PPPort::eval_sv('$@ = "string2"; die "string3"', &Devel::PPPort::G_RETHROW); 1 }); ok($@ =~ /^string3 at \(eval [0-9]+\) line 1\.\n$/); +ok(!eval { Devel::PPPort::eval_sv('die False->new', &Devel::PPPort::G_RETHROW); 1 }, 'check false value is rethrown'); if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) { my $hashref = { key => 'value' }; diff --git a/dist/Devel-PPPort/parts/inc/format b/dist/Devel-PPPort/parts/inc/format index 738b703f9f..094076febe 100644 --- a/dist/Devel-PPPort/parts/inc/format +++ b/dist/Devel-PPPort/parts/inc/format @@ -107,11 +107,12 @@ is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX'); is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX'); my $ivsize = $Config::Config{ivsize}; -my $ivmax = ($ivsize == 4) ? '2147483647' : ($ivsize == 8) ? '9223372036854775807' : 0; -my $uvmax = ($ivsize == 4) ? '4294967295' : ($ivsize == 8) ? '18446744073709551615' : 0; -if ($ivmax == 0) { - skip 'skip: unknown ivsize', 2; -} else { +if ($ivsize && ($ivsize == 4 || $ivsize == 8)) { + my $ivmax = ($ivsize == 4) ? '2147483647' : '9223372036854775807'; + my $uvmax = ($ivsize == 4) ? '4294967295' : '18446744073709551615'; is(Devel::PPPort::sprintf_ivmax(), $ivmax); is(Devel::PPPort::sprintf_uvmax(), $uvmax); } +else { + skip 'skip: unknown ivsize', 2; +} diff --git a/dist/Devel-PPPort/parts/inc/magic b/dist/Devel-PPPort/parts/inc/magic index 28e161d900..3d3b740fc7 100644 --- a/dist/Devel-PPPort/parts/inc/magic +++ b/dist/Devel-PPPort/parts/inc/magic @@ -33,12 +33,21 @@ __UNDEFINED__ sv_catsv_nomg sv_catsv __UNDEFINED__ sv_setsv_nomg sv_setsv __UNDEFINED__ sv_pvn_nomg sv_pvn -#ifdef SV_NOSTEAL +#ifdef SVf_IVisUV +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +__UNDEFINED__ SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ({ SV *_sviv = sv_mortalcopy_flags((sv), SV_NOSTEAL); IV _iv = SvIV(_sviv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_sviv) & SVf_IVisUV); _iv; })) +__UNDEFINED__ SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : ({ SV *_svuv = sv_mortalcopy_flags((sv), SV_NOSTEAL); UV _uv = SvUV(_svuv); SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(_svuv) & SVf_IVisUV); _uv; })) +#else +__UNDEFINED__ SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ((PL_Sv = sv_mortalcopy_flags((sv), SV_NOSTEAL)), sv_upgrade(PL_Sv, SVt_PVIV), (SvIVX(PL_Sv) = SvIV(PL_Sv)), (SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(PL_Sv) & SVf_IVisUV)), SvIVX(PL_Sv))) +__UNDEFINED__ SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : ((PL_Sv = sv_mortalcopy_flags((sv), SV_NOSTEAL)), sv_upgrade(PL_Sv, SVt_PVIV), (SvUVX(PL_Sv) = SvUV(PL_Sv)), (SvFLAGS((sv)) = (SvFLAGS((sv)) & ~SVf_IVisUV) | (SvFLAGS(PL_Sv) & SVf_IVisUV)), SvUVX(PL_Sv))) +#endif +#else __UNDEFINED__ SvIV_nomg(sv) (!SvGMAGICAL((sv)) ? SvIV((sv)) : SvIVx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) __UNDEFINED__ SvUV_nomg(sv) (!SvGMAGICAL((sv)) ? SvUV((sv)) : SvUVx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) +#endif + __UNDEFINED__ SvNV_nomg(sv) (!SvGMAGICAL((sv)) ? SvNV((sv)) : SvNVx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) __UNDEFINED__ SvTRUE_nomg(sv) (!SvGMAGICAL((sv)) ? SvTRUE((sv)) : SvTRUEx(sv_mortalcopy_flags((sv), SV_NOSTEAL))) -#endif #ifndef sv_catpv_mg # define sv_catpv_mg(sv, ptr) \ @@ -491,6 +500,25 @@ sv_magic_portable(sv) OUTPUT: RETVAL +UV +above_IV_MAX() + CODE: + RETVAL = (UV)IV_MAX+100; + OUTPUT: + RETVAL + +#ifdef SVf_IVisUV + +U32 +SVf_IVisUV(sv) + SV *sv + CODE: + RETVAL = (SvFLAGS(sv) & SVf_IVisUV); + OUTPUT: + RETVAL + +#endif + #ifdef SvIV_nomg IV @@ -551,7 +579,7 @@ magic_SvPV_nomg_nolen(sv) #endif -=tests plan => 45 +=tests plan => 63 # Find proper magic ok(my $obj1 = Devel::PPPort->new_with_mg()); @@ -623,9 +651,6 @@ my $foo = 'bar'; ok(Devel::PPPort::sv_magic_portable($foo)); ok($foo eq 'bar'); -if ( "$]" < '5.007003' ) { - skip 'skip: no SV_NOSTEAL support', 22; -} else { tie my $scalar, 'TieScalarCounter', 10; my $fetch = $scalar; @@ -654,7 +679,50 @@ if ( "$]" < '5.007003' ) { is Devel::PPPort::magic_SvNV_nomg($object), 5.5; is Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string'; ok !Devel::PPPort::magic_SvTRUE_nomg($object); + +tie my $negative, 'TieScalarCounter', -1; +$fetch = $negative; + +is tied($negative)->{fetch}, 1; +is tied($negative)->{store}, 0; +is Devel::PPPort::magic_SvIV_nomg($negative), -1; +if (ivers($]) >= ivers(5.6)) { + ok !Devel::PPPort::SVf_IVisUV($negative); +} else { + skip 'SVf_IVisUV is unsupported', 1; +} +is tied($negative)->{fetch}, 1; +is tied($negative)->{store}, 0; +Devel::PPPort::magic_SvUV_nomg($negative); +if (ivers($]) >= ivers(5.6)) { + ok !Devel::PPPort::SVf_IVisUV($negative); +} else { + skip 'SVf_IVisUV is unsupported', 1; +} +is tied($negative)->{fetch}, 1; +is tied($negative)->{store}, 0; + +tie my $big, 'TieScalarCounter', Devel::PPPort::above_IV_MAX(); +$fetch = $big; + +is tied($big)->{fetch}, 1; +is tied($big)->{store}, 0; +Devel::PPPort::magic_SvIV_nomg($big); +if (ivers($]) >= ivers(5.6)) { + ok Devel::PPPort::SVf_IVisUV($big); +} else { + skip 'SVf_IVisUV is unsupported', 1; +} +is tied($big)->{fetch}, 1; +is tied($big)->{store}, 0; +is Devel::PPPort::magic_SvUV_nomg($big), Devel::PPPort::above_IV_MAX(); +if (ivers($]) >= ivers(5.6)) { + ok Devel::PPPort::SVf_IVisUV($big); +} else { + skip 'SVf_IVisUV is unsupported', 1; } +is tied($big)->{fetch}, 1; +is tied($big)->{store}, 0; package TieScalarCounter; diff --git a/dist/Devel-PPPort/parts/inc/memory b/dist/Devel-PPPort/parts/inc/memory index aa986f5b6a..aa102e22e6 100644 --- a/dist/Devel-PPPort/parts/inc/memory +++ b/dist/Devel-PPPort/parts/inc/memory @@ -27,6 +27,8 @@ __UNDEFINED__ memEQs(s1, l, s2) \ (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1))) __UNDEFINED__ memNEs(s1, l, s2) !memEQs(s1, l, s2) +__UNDEFINED__ memCHRs(s, c) ((const char *) memchr("" s "" , c, sizeof(s)-1)) + __UNDEFINED__ MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) __UNDEFINED__ CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) #ifdef HAS_MEMSET diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc index 5705a5f01e..deb1fb87a6 100644 --- a/dist/Devel-PPPort/parts/inc/misc +++ b/dist/Devel-PPPort/parts/inc/misc @@ -50,7 +50,7 @@ __UNDEFINED__ __ASSERT_(statement) assert(statement), __UNDEFINED__ __ASSERT_(statement) #endif -/* These could become provided when they become part of the public API */ +/* These could become provided if/when they become part of the public API */ __UNDEF_NOT_PROVIDED__ withinCOUNT(c, l, n) \ (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0)))) __UNDEF_NOT_PROVIDED__ inRANGE(c, l, u) \ @@ -59,6 +59,12 @@ __UNDEF_NOT_PROVIDED__ inRANGE(c, l, u) \ : (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \ : (withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l))))) +/* The '| 0' part ensures a compiler error if c is not integer (like e.g., a + * pointer) */ +#undef FITS_IN_8_BITS /* handy.h version uses a core-only constant */ +__UNDEF_NOT_PROVIDED__ FITS_IN_8_BITS(c) ( (sizeof(c) == 1) \ + || !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF)) + /* Create the macro for "is'macro'_utf8_safe(s, e)". For code points below * 256, it calls the equivalent _L1 macro by converting the UTF-8 to code * point. That is so that it can automatically get the bug fixes done in this @@ -575,10 +581,10 @@ __UNDEFINED__ isALPHANUMERIC_L1(c) (isALPHA_L1(c) || isDIGIT(c)) __UNDEFINED__ isALPHANUMERIC_LC(c) (isALPHA_LC(c) || isDIGIT_LC(c)) __UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t') __UNDEFINED__ isBLANK_L1(c) ( isBLANK(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || ( FITS_IN_8_BITS(c) \ && NATIVE_TO_LATIN1((U8) c) == 0xA0)) __UNDEFINED__ isBLANK_LC(c) isBLANK(c) -__UNDEFINED__ isDIGIT(c) ((c) <= '9' && (c) >= '0') +__UNDEFINED__ isDIGIT(c) inRANGE(c, '0', '9') __UNDEFINED__ isDIGIT_L1(c) isDIGIT(c) __UNDEFINED__ isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c)) __UNDEFINED__ isGRAPH_L1(c) ( isPRINT_L1(c) \ @@ -591,7 +597,7 @@ __UNDEFINED__ isIDFIRST(c) (isALPHA(c) || (c) == '_') __UNDEFINED__ isIDFIRST_L1(c) (isALPHA_L1(c) || (U8) (c) == '_') __UNDEFINED__ isIDFIRST_LC(c) (isALPHA_LC(c) || (U8) (c) == '_') __UNDEFINED__ isLOWER_L1(c) ( isLOWER(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || ( FITS_IN_8_BITS(c) \ && ( ( NATIVE_TO_LATIN1((U8) c) >= 0xDF \ && NATIVE_TO_LATIN1((U8) c) != 0xF7) \ || NATIVE_TO_LATIN1((U8) c) == 0xAA \ @@ -600,7 +606,7 @@ __UNDEFINED__ isLOWER_L1(c) ( isLOWER(c) \ __UNDEFINED__ isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0') __UNDEFINED__ isOCTAL_L1(c) isOCTAL(c) __UNDEFINED__ isPRINT(c) (isGRAPH(c) || (c) == ' ') -__UNDEFINED__ isPRINT_L1(c) ((WIDEST_UTYPE) (c) < 256 && ! isCNTRL_L1(c)) +__UNDEFINED__ isPRINT_L1(c) (FITS_IN_8_BITS(c) && ! isCNTRL_L1(c)) __UNDEFINED__ isPSXSPC(c) isSPACE(c) __UNDEFINED__ isPSXSPC_L1(c) isSPACE_L1(c) __UNDEFINED__ isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \ @@ -615,7 +621,7 @@ __UNDEFINED__ isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \ || (c) == '`' || (c) == '{' || (c) == '|' \ || (c) == '}' || (c) == '~') __UNDEFINED__ isPUNCT_L1(c) ( isPUNCT(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || ( FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) == 0xA1 \ || NATIVE_TO_LATIN1((U8) c) == 0xA7 \ || NATIVE_TO_LATIN1((U8) c) == 0xAB \ @@ -626,11 +632,11 @@ __UNDEFINED__ isPUNCT_L1(c) ( isPUNCT(c) \ __UNDEFINED__ isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \ || (c) == '\v' || (c) == '\f') __UNDEFINED__ isSPACE_L1(c) ( isSPACE(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || (FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) == 0x85 \ || NATIVE_TO_LATIN1((U8) c) == 0xA0))) __UNDEFINED__ isUPPER_L1(c) ( isUPPER(c) \ - || ( (WIDEST_UTYPE) (c) < 256 \ + || (FITS_IN_8_BITS(c) \ && ( NATIVE_TO_LATIN1((U8) c) >= 0xC0 \ && NATIVE_TO_LATIN1((U8) c) <= 0xDE \ && NATIVE_TO_LATIN1((U8) c) != 0xD7))) @@ -665,20 +671,27 @@ __UNDEFINED__ isWORDCHAR_A(c) isWORDCHAR(c) __UNDEFINED__ isXDIGIT_A(c) isXDIGIT(c) __UNDEFINED__ isASCII_utf8_safe(s,e) (((e) - (s)) <= 0 ? 0 : isASCII(*(s))) -__UNDEFINED__ isASCII_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isASCII_L1(c) : 0) +__UNDEFINED__ isASCII_uvchr(c) (FITS_IN_8_BITS(c) ? isASCII_L1(c) : 0) #if { VERSION >= 5.006 } +# ifdef isALPHA_uni /* If one defined, all are; this is just an exemplar */ +# define D_PPP_is_ctype(upper, lower, c) \ + (FITS_IN_8_BITS(c) \ + ? is ## upper ## _L1(c) \ + : is ## upper ## _uni((UV) (c))) /* _uni is old synonym */ +# else +# define D_PPP_is_ctype(upper, lower, c) \ + (FITS_IN_8_BITS(c) \ + ? is ## upper ## _L1(c) \ + : is_uni_ ## lower((UV) (c))) /* is_uni_ is even older */ +# endif -__UNDEFINED__ isALPHA_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isALPHA_L1(c) : is_uni_alpha((UV) (c))) -__UNDEFINED__ isALPHANUMERIC_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isALPHANUMERIC_L1(c) : (is_uni_alpha((UV) (c)) || is_uni_digit((UV) (c)))) +__UNDEFINED__ isALPHA_uvchr(c) D_PPP_is_ctype(ALPHA, alpha, c) +__UNDEFINED__ isALPHANUMERIC_uvchr(c) (isALPHA_uvchr(c) || isDIGIT_uvchr(c)) # ifdef is_uni_blank -__UNDEFINED__ isBLANK_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isBLANK_L1(c) : is_uni_blank((UV) (c))) +__UNDEFINED__ isBLANK_uvchr(c) D_PPP_is_ctype(BLANK, blank, c) # else -__UNDEFINED__ isBLANK_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ +__UNDEFINED__ isBLANK_uvchr(c) (FITS_IN_8_BITS(c) \ ? isBLANK_L1(c) \ : ( (UV) (c) == 0x1680 /* Unicode 3.0 */ \ || inRANGE((UV) (c), 0x2000, 0x200A) \ @@ -686,30 +699,20 @@ __UNDEFINED__ isBLANK_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ || (UV) (c) == 0x205F /* Unicode 3.2 */\ || (UV) (c) == 0x3000)) # endif -__UNDEFINED__ isCNTRL_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isCNTRL_L1(c) : is_uni_cntrl((UV) (c))) -__UNDEFINED__ isDIGIT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isDIGIT_L1(c) : is_uni_digit((UV) (c))) -__UNDEFINED__ isGRAPH_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isGRAPH_L1(c) : is_uni_graph((UV) (c))) -__UNDEFINED__ isIDCONT_uvchr(c) isWORDCHAR_uvchr(c) -__UNDEFINED__ isIDFIRST_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isIDFIRST_L1(c) : is_uni_idfirst((UV) (c))) -__UNDEFINED__ isLOWER_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isLOWER_L1(c) : is_uni_lower((UV) (c))) -__UNDEFINED__ isPRINT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isPRINT_L1(c) : is_uni_print((UV) (c))) +__UNDEFINED__ isCNTRL_uvchr(c) D_PPP_is_ctype(CNTRL, cntrl, c) +__UNDEFINED__ isDIGIT_uvchr(c) D_PPP_is_ctype(DIGIT, digit, c) +__UNDEFINED__ isGRAPH_uvchr(c) D_PPP_is_ctype(GRAPH, graph, c) +__UNDEFINED__ isIDCONT_uvchr(c) isWORDCHAR_uvchr(c) +__UNDEFINED__ isIDFIRST_uvchr(c) D_PPP_is_ctype(IDFIRST, idfirst, c) +__UNDEFINED__ isLOWER_uvchr(c) D_PPP_is_ctype(LOWER, lower, c) +__UNDEFINED__ isPRINT_uvchr(c) D_PPP_is_ctype(PRINT, print, c) __UNDEFINED__ isPSXSPC_uvchr(c) isSPACE_uvchr(c) -__UNDEFINED__ isPUNCT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isPUNCT_L1(c) : is_uni_punct((UV) (c))) -__UNDEFINED__ isSPACE_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isSPACE_L1(c) : is_uni_space((UV) (c))) -__UNDEFINED__ isUPPER_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isUPPER_L1(c) : is_uni_upper((UV) (c))) -__UNDEFINED__ isXDIGIT_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isXDIGIT_L1(c) : is_uni_xdigit((UV) (c))) -__UNDEFINED__ isWORDCHAR_uvchr(c) ((WIDEST_UTYPE) (c) < 256 \ - ? isWORDCHAR_L1(c) : is_uni_alnum((UV) (c))) +__UNDEFINED__ isPUNCT_uvchr(c) D_PPP_is_ctype(PUNCT, punct, c) +__UNDEFINED__ isSPACE_uvchr(c) D_PPP_is_ctype(SPACE, space, c) +__UNDEFINED__ isUPPER_uvchr(c) D_PPP_is_ctype(UPPER, upper, c) +__UNDEFINED__ isXDIGIT_uvchr(c) D_PPP_is_ctype(XDIGIT, xdigit, c) +__UNDEFINED__ isWORDCHAR_uvchr(c) (FITS_IN_8_BITS(c) \ + ? isWORDCHAR_L1(c) : isALPHANUMERIC_uvchr(c)) __UNDEFINED__ isALPHA_utf8_safe(s,e) D_PPP_IS_GENERIC_UTF8_SAFE(s, e, ALPHA) # ifdef isALPHANUMERIC_utf8 @@ -1868,6 +1871,7 @@ isASCII_utf8_safe(s, offset) unsigned char * s int offset CODE: + PERL_UNUSED_ARG(offset); RETVAL = isASCII_utf8_safe(s, s + 1 + offset); OUTPUT: RETVAL @@ -2169,6 +2173,7 @@ isASCII_LC_utf8_safe(s, offset) unsigned char * s int offset CODE: + PERL_UNUSED_ARG(offset); RETVAL = isASCII_utf8_safe(s, s + UTF8SKIP(s) + offset); OUTPUT: RETVAL @@ -2526,30 +2531,30 @@ av_top_index(av) use vars qw($my_sv @my_av %my_hv); -ok(&Devel::PPPort::boolSV(1)); -ok(!&Devel::PPPort::boolSV(0)); +ok(&Devel::PPPort::boolSV(1), "Verify boolSV(1) is true"); +ok(!&Devel::PPPort::boolSV(0), "Verify boolSV(0) is false"); $_ = "Fred"; -is(&Devel::PPPort::DEFSV(), "Fred"); -is(&Devel::PPPort::UNDERBAR(), "Fred"); +is(&Devel::PPPort::DEFSV(), "Fred", '$_ is FRED; Verify DEFSV is FRED'); +is(&Devel::PPPort::UNDERBAR(), "Fred", 'And verify UNDERBAR is FRED'); if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) { eval q{ no warnings "deprecated"; - no if $^V > v5.17.9, warnings => "experimental::lexical_topic"; + no if $^V >= v5.17.9, warnings => "experimental::lexical_topic"; my $_ = "Tony"; - is(&Devel::PPPort::DEFSV(), "Fred"); - is(&Devel::PPPort::UNDERBAR(), "Tony"); + is(&Devel::PPPort::DEFSV(), "Fred", 'lexical_topic eval: $_ is Tony; Verify DEFSV is Fred'); + is(&Devel::PPPort::UNDERBAR(), "Tony", 'And verify UNDERBAR is Tony'); }; + die __FILE__ . __LINE__ . ": $@" if $@; } else { - ok(1); - ok(1); + skip("perl version outside testing range of lexical_topic", 2); } my @r = &Devel::PPPort::DEFSV_modify(); -ok(@r == 3); +ok(@r == 3, "Verify got 3 elements"); is($r[0], 'Fred'); is($r[1], 'DEFSV'); is($r[2], 'Fred'); @@ -2557,9 +2562,9 @@ is($r[2], 'Fred'); is(&Devel::PPPort::DEFSV(), "Fred"); eval { 1 }; -ok(!&Devel::PPPort::ERRSV()); +ok(!&Devel::PPPort::ERRSV(), "Verify ERRSV on true is false"); eval { cannot_call_this_one() }; -ok(&Devel::PPPort::ERRSV()); +ok(&Devel::PPPort::ERRSV(), "Verify ERRSV on false is true"); ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); @@ -2593,8 +2598,8 @@ is(Devel::PPPort::prepush(), 42); is(join(':', Devel::PPPort::xsreturn(0)), 'test1'); is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); -is(Devel::PPPort::PERL_ABS(42), 42); -is(Devel::PPPort::PERL_ABS(-13), 13); +is(Devel::PPPort::PERL_ABS(42), 42, "Verify PERL_ABS(42) is 42"); +is(Devel::PPPort::PERL_ABS(-13), 13, "Verify PERL_ABS(-13) is 13"); is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42'); is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc'); @@ -2625,7 +2630,7 @@ if (ivers($]) < ivers(5.5)) { skip 'no qr// objects in this perl', 2; } else { my $qr = eval 'qr/./'; - ok(Devel::PPPort::SvRXOK($qr)); + ok(Devel::PPPort::SvRXOK($qr), "SVRXOK(qr) is true"); ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise")); } @@ -2634,7 +2639,7 @@ ok( Devel::PPPort::NATIVE_TO_LATIN1(0x1) == 0x1); ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("A")) == 0x41); ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("0")) == 0x30); -ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6); +ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6, "Verify LATIN1_TO_NATIVE(0xB6) is 0xB6"); if (ord("A") == 65) { ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0x41); ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0x30); @@ -2648,14 +2653,14 @@ ok( Devel::PPPort::isALNUMC_L1(ord("5"))); ok( Devel::PPPort::isALNUMC_L1(0xFC)); ok(! Devel::PPPort::isALNUMC_L1(0xB6)); -ok( Devel::PPPort::isOCTAL(ord("7"))); -ok(! Devel::PPPort::isOCTAL(ord("8"))); +ok( Devel::PPPort::isOCTAL(ord("7")), "Verify '7' is OCTAL"); +ok(! Devel::PPPort::isOCTAL(ord("8")), "Verify '8' isn't OCTAL"); -ok( Devel::PPPort::isOCTAL_A(ord("0"))); -ok(! Devel::PPPort::isOCTAL_A(ord("9"))); +ok( Devel::PPPort::isOCTAL_A(ord("0")), "Verify '0' is OCTAL_A"); +ok(! Devel::PPPort::isOCTAL_A(ord("9")), "Verify '9' isn't OCTAL_A"); -ok( Devel::PPPort::isOCTAL_L1(ord("2"))); -ok(! Devel::PPPort::isOCTAL_L1(ord("8"))); +ok( Devel::PPPort::isOCTAL_L1(ord("2")), "Verify '2' is OCTAL_L1"); +ok(! Devel::PPPort::isOCTAL_L1(ord("8")), "Verify '8' isn't OCTAL_L1"); my $way_too_early_msg = 'UTF-8 not implemented on this perl'; @@ -2755,7 +2760,7 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { XDIGIT)) { if ($i < 256) { # For the ones that can fit in a byte, test each of - #three macros. + # three macros. my $suffix; for $suffix ("", "_A", "_L1", "_uvchr") { my $should_be = ($i > 0x7F && $suffix !~ /_(uvchr|L1)/) @@ -2767,6 +2772,7 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } my $eval_string = "Devel::PPPort::is${class}$suffix($hex)"; + local $SIG{__WARN__} = sub {}; my $is = eval $eval_string || 0; die "eval 'For $i: $eval_string' gave $@" if $@; is($is, $should_be, "'$eval_string'"); @@ -2796,10 +2802,10 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { skip $skip, 1; } else { - $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i); + $utf8 = quotemeta Devel::PPPort::uvchr_to_utf8($native); my $should_be = $types{"$native:$class"} || 0; - local $SIG{__WARN__} = sub {}; my $eval_string = "$fcn(\"$utf8\", 0)"; + local $SIG{__WARN__} = sub {}; my $is = eval $eval_string || 0; die "eval 'For $i, $eval_string' gave $@" if $@; is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string)); @@ -2816,7 +2822,8 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } else { my $eval_string = "$fcn(\"$utf8\", -1)"; - my $is = eval "no warnings; $eval_string" || 0; + local $SIG{__WARN__} = sub {}; + my $is = eval "$eval_string" || 0; die "eval '$eval_string' gave $@" if $@; is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string)); } @@ -2826,23 +2833,30 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } my %case_changing = ( 'LOWER' => [ [ ord('A'), ord('a') ], - [ 0xC0, 0xE0 ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0), + Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ], [ 0x100, 0x101 ], ], 'FOLD' => [ [ ord('C'), ord('c') ], - [ 0xC0, 0xE0 ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0), + Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ], [ 0x104, 0x105 ], - [ 0xDF, 'ss' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'ss' ], ], - 'UPPER' => [ [ ord('a'),ord('A'), ], - [ 0xE0, 0xC0 ], + 'UPPER' => [ [ ord('a'), ord('A'), ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xE0), + Devel::PPPort::LATIN1_TO_NATIVE(0xC0) ], [ 0x101, 0x100 ], - [ 0xDF, 'SS' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'SS' ], ], - 'TITLE' => [ [ ord('c'),ord('C'), ], - [ 0xE2, 0xC2 ], + 'TITLE' => [ [ ord('c'), ord('C'), ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xE2), + Devel::PPPort::LATIN1_TO_NATIVE(0xC2) ], [ 0x103, 0x102 ], - [ 0xDF, 'Ss' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'Ss' ], ], ); @@ -2859,11 +2873,11 @@ for $name (keys %case_changing) { my $should_be_bytes; if (ivers($]) >= ivers(5.6)) { if ($is_cp) { - $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed); + $utf8_changed = Devel::PPPort::uvchr_to_utf8($changed); $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0); } else { - die("Test currently doesn't work for non-ASCII multi-char case changes") if $utf8_changed =~ /[[:^ascii:]]/; + die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /[[:^ascii:]]/'; $should_be_bytes = length $utf8_changed; } } @@ -2882,11 +2896,12 @@ for $name (keys %case_changing) { } else { if ($is_cp) { - $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed); + $utf8_changed = Devel::PPPort::uvchr_to_utf8($changed); $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0); } else { - die("Test currently doesn't work for non-ASCII multi-char case changes") if $utf8_changed =~ /[[:^ascii:]]/; + my $non_ascii_re = (ivers($]) >= ivers(5.6)) ? '[[:^ascii:]]' : '[^\x00-\x7F]'; + die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /$non_ascii_re/'; $should_be_bytes = length $utf8_changed; } @@ -2927,7 +2942,7 @@ for $name (keys %case_changing) { } else { my $fcn = "to${name}_utf8_safe"; - my $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($original); + my $utf8 = quotemeta Devel::PPPort::uvchr_to_utf8($original); my $real_truncate = ($truncate < 2) ? $truncate : $should_be_bytes; my $eval_string = "Devel::PPPort::$fcn(\"$utf8\", $real_truncate)"; diff --git a/dist/Devel-PPPort/parts/inc/podtest b/dist/Devel-PPPort/parts/inc/podtest index c44c10d2da..df18c3a4a8 100644 --- a/dist/Devel-PPPort/parts/inc/podtest +++ b/dist/Devel-PPPort/parts/inc/podtest @@ -22,11 +22,11 @@ else { # Try loading Test::Pod eval q{ use Test::Pod; - $Test::Pod::VERSION >= 0.95 + $Test::Pod::VERSION >= 1.41 or die "Test::Pod version only $Test::Pod::VERSION"; import Test::Pod tests => scalar @pods; }; - $reason = 'Test::Pod >= 0.95 required' if $@; + $reason = 'Test::Pod >= 1.41 required' if $@; } if ($reason) { diff --git a/dist/Devel-PPPort/parts/inc/ppphbin b/dist/Devel-PPPort/parts/inc/ppphbin index 3057d12888..975e3f64ba 100644 --- a/dist/Devel-PPPort/parts/inc/ppphbin +++ b/dist/Devel-PPPort/parts/inc/ppphbin @@ -15,6 +15,8 @@ use strict; +BEGIN { require warnings if "$]" > '5.006' } + # Disable broken TRIE-optimization BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 } @@ -115,8 +117,8 @@ my($hint, $define, $function); sub find_api { + BEGIN { 'warnings'->unimport('uninitialized') if "$]" > '5.006' } my $code = shift; - no warnings 'uninitialized'; $code =~ s{ / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) | "[^"\\]*(?:\\.[^"\\]*)*" diff --git a/dist/Devel-PPPort/parts/inc/utf8 b/dist/Devel-PPPort/parts/inc/utf8 index ee30dc5ecf..28f01c058d 100644 --- a/dist/Devel-PPPort/parts/inc/utf8 +++ b/dist/Devel-PPPort/parts/inc/utf8 @@ -1,12 +1,28 @@ =provides __UNDEFINED__ +SvUTF8 +UTF8f +UTF8fARG utf8_to_uvchr_buf sv_len_utf8 sv_len_utf8_nomg =implementation +#ifdef SVf_UTF8 +__UNDEFINED__ SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) +#endif + +#if { VERSION == 5.19.1 } /* 5.19.1 does not have UTF8fARG, only broken UTF8f */ +#undef UTF8f +#endif + +#ifdef SVf_UTF8 +__UNDEFINED__ UTF8f SVf +__UNDEFINED__ UTF8fARG(u,l,p) newSVpvn_flags((p), (l), ((u) ? SVf_UTF8 : 0) | SVs_TEMP) +#endif + #define D_PPP_MIN(a,b) (((a) <= (b)) ? (a) : (b)) __UNDEFINED__ UNICODE_REPLACEMENT 0xFFFD @@ -98,6 +114,7 @@ __UNDEFINED__ UTF8_SAFE_SKIP(s, e) ( __UNDEFINED__ UTF8_CHK_SKIP(s) \ (s[0] == '\0' ? 1 : ((U8) D_PPP_MIN(my_strnlen((char *) (s), UTF8SKIP(s)), \ UTF8SKIP(s)))) +/* UTF8_CHK_SKIP depends on my_strnlen */ __UNDEFINED__ UTF8_SKIP(s) UTF8SKIP(s) #endif @@ -298,8 +315,9 @@ utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) * The modern versions allow anything that evaluates to a legal UV, but * not overlongs nor an empty input */ ret = D_PPP_utf8_to_uvchr_buf_callee( - s, curlen, retlen, (UTF8_ALLOW_ANYUV - & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY))); + (U8 *) /* Early perls: no const */ + s, curlen, retlen, (UTF8_ALLOW_ANYUV + & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY))); # if { VERSION >= 5.26.0 } && { VERSION < 5.28.0 } @@ -348,6 +366,7 @@ utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) } else { ret = D_PPP_utf8_to_uvchr_buf_callee( + (U8 *) /* Early perls: no const */ s, curlen, retlen, UTF8_ALLOW_ANY); /* Override with the REPLACEMENT character, as that is what the * modern version of this function returns */ @@ -359,7 +378,7 @@ utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) * length. It should not extend past the end of string, nor past * what the first byte indicates the length is, nor past the * continuation characters */ - if (retlen && *retlen >= 0) { + if (retlen && (IV) *retlen >= 0) { unsigned int i = 1; *retlen = D_PPP_MIN(*retlen, curlen); @@ -411,7 +430,7 @@ __UNDEFINED__ utf8_to_uvchr(s, lp) /* Replace utf8_to_uvchr with utf8_to_uvchr_buf */ -#ifdef SV_NOSTEAL +#ifdef sv_len_utf8 /* Older Perl versions have broken sv_len_utf8() when passed sv does not have SVf_UTF8 flag set */ /* Also note that SvGETMAGIC() may change presence of SVf_UTF8 flag */ # if { VERSION < 5.17.5 } @@ -437,22 +456,40 @@ __UNDEFINED__ utf8_to_uvchr(s, lp) =xsubs +#if defined(UTF8f) && defined(newSVpvf) + +void +UTF8f(x) + SV *x + PREINIT: + U32 u; + STRLEN len; + char *ptr; + INIT: + ptr = SvPV(x, len); + u = SvUTF8(x); + PPCODE: + x = sv_2mortal(newSVpvf("[%" UTF8f "]", UTF8fARG(u, len, ptr))); + XPUSHs(x); + XSRETURN(1); + +#endif + #if { VERSION >= 5.006 } /* This is just a helper fcn, not publicized */ \ /* as being available and params not what the */ \ /* API function has; works on EBCDIC too */ SV * -uvoffuni_to_utf8(uni) +uvchr_to_utf8(native) - UV uni + UV native PREINIT: int len; U8 string[UTF8_MAXBYTES+1]; int i; - UV native; - CODE: - native = UNI_TO_NATIVE(uni); + UV uni; + CODE: len = UVCHR_SKIP(native); for (i = 0; i < len; i++) { @@ -464,6 +501,7 @@ uvoffuni_to_utf8(uni) } else { i = len; + uni = NATIVE_TO_UNI(native); while (i-- > 1) { string[i] = I8_TO_NATIVE_UTF8((uni & UTF_CONTINUATION_MASK) | UTF_CONTINUATION_MARK); uni >>= UTF_ACCUMULATION_SHIFT; @@ -589,7 +627,7 @@ utf8_to_uvchr(s) #endif -#ifdef SV_NOSTEAL +#ifdef sv_len_utf8 STRLEN sv_len_utf8(sv) @@ -599,6 +637,10 @@ sv_len_utf8(sv) OUTPUT: RETVAL +#endif + +#ifdef sv_len_utf8_nomg + STRLEN sv_len_utf8_nomg(sv) SV *sv @@ -635,16 +677,27 @@ UVCHR_SKIP(c) #endif -=tests plan => 93 +=tests plan => 98 -BEGIN { require warnings if "$]" > '5.006' } - -# skip tests on 5.6.0 and earlier, plus 7.0 -if ("$]" <= '5.006' || "$]" == '5.007' ) { - skip 'skip: broken utf8 support', 93; - exit; +BEGIN { + # skip tests on 5.6.0 and earlier, plus 5.7.0 + if (ivers($]) <= ivers(5.6) || ivers($]) == ivers(5.7) ) { + skip 'skip: broken utf8 support', 98; + exit; + } + require warnings; } +is(Devel::PPPort::UTF8f(42), '[42]'); +is(Devel::PPPort::UTF8f('abc'), '[abc]'); +is(Devel::PPPort::UTF8f("\x{263a}"), "[\x{263a}]"); + +my $str = "\x{A8}"; +if (ivers($]) >= ivers(5.8)) { eval q{utf8::upgrade($str)} } +is(Devel::PPPort::UTF8f($str), "[\x{A8}]"); +if (ivers($]) >= ivers(5.8)) { eval q{utf8::downgrade($str)} } +is(Devel::PPPort::UTF8f($str), "[\x{A8}]"); + is(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1); is(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0); @@ -657,27 +710,22 @@ is(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1); ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0xb6)); ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0x100)); -if ("$]" < '5.006') { - skip("Perl version too early", 9); +is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1); +is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test"); +is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6); +is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7); +if (ord("A") != 65) { + skip("Test not valid on EBCDIC", 1) } else { - is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1); - is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test"); - is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6); - is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7); - if (ord("A") != 65) { - skip("Test not valid on EBCDIC", 1) - } - else { - is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7); - } + is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7); } -if ("$]" < '5.008') { +if (ivers($]) < ivers(5.8)) { skip("Perl version too early", 3); } else { @@ -702,8 +750,53 @@ $ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0); is($ret->[0], 0); is($ret->[1], 1); +my @buf_tests = ( + { + input => "A", + adjustment => -1, + warning => eval "qr/empty/", + no_warnings_returned_length => 0, + }, + { + input => "\xc4\xc5", + adjustment => 0, + warning => eval "qr/non-continuation/", + no_warnings_returned_length => 1, + }, + { + input => "\xc4\x80", + adjustment => -1, + warning => eval "qr/short|1 byte, need 2/", + no_warnings_returned_length => 1, + }, + { + input => "\xc0\x81", + adjustment => 0, + warning => eval "qr/overlong|2 bytes, need 1/", + no_warnings_returned_length => 2, + }, + { + input => "\xe0\x80\x81", + adjustment => 0, + warning => eval "qr/overlong|3 bytes, need 1/", + no_warnings_returned_length => 3, + }, + { + input => "\xf0\x80\x80\x81", + adjustment => 0, + warning => eval "qr/overlong|4 bytes, need 1/", + no_warnings_returned_length => 4, + }, + { # Old algorithm failed to detect this + input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf", + adjustment => 0, + warning => eval "qr/overflow/", + no_warnings_returned_length => 13, + }, +); + if (ord("A") != 65) { # tests not valid for EBCDIC - skip("Perl version too early", 1 .. (2 + 4 + (7 * 5))); + skip("Perl version too early", 2 + 4 + (scalar @buf_tests * 5)); } else { $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0); @@ -714,67 +807,29 @@ else { local $SIG{__WARN__} = sub { push @warnings, @_; }; { - BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' } + use warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80"); is($ret->[0], 0); is($ret->[1], -1); - BEGIN { 'warnings'->unimport() if "$]" > '5.006' } + no warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80"); is($ret->[0], 0xFFFD); is($ret->[1], 1); } - my @buf_tests = ( - { - input => "A", - adjustment => -1, - warning => eval "qr/empty/", - no_warnings_returned_length => 0, - }, - { - input => "\xc4\xc5", - adjustment => 0, - warning => eval "qr/non-continuation/", - no_warnings_returned_length => 1, - }, - { - input => "\xc4\x80", - adjustment => -1, - warning => eval "qr/short|1 byte, need 2/", - no_warnings_returned_length => 1, - }, - { - input => "\xc0\x81", - adjustment => 0, - warning => eval "qr/overlong|2 bytes, need 1/", - no_warnings_returned_length => 2, - }, - { - input => "\xe0\x80\x81", - adjustment => 0, - warning => eval "qr/overlong|3 bytes, need 1/", - no_warnings_returned_length => 3, - }, - { - input => "\xf0\x80\x80\x81", - adjustment => 0, - warning => eval "qr/overlong|4 bytes, need 1/", - no_warnings_returned_length => 4, - }, - { # Old algorithm failed to detect this - input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf", - adjustment => 0, - warning => eval "qr/overflow/", - no_warnings_returned_length => 13, - }, - ); # An empty input is an assertion failure on debugging builds. It is # deliberately the first test. require Config; import Config; use vars '%Config'; - if ($Config{ccflags} =~ /-DDEBUGGING/) { + + # VMS doesn't put DEBUGGING in ccflags, and Windows doesn't have + # $Config{config_args}. When 5.14 or later can be assumed, use + # Config::non_bincompat_options(), but for now we're stuck with this. + if ( $Config{ccflags} =~ /-DDEBUGGING/ + || $^O eq 'VMS' && $Config{config_args} =~ /\bDDEBUGGING\b/) + { shift @buf_tests; skip("Test not valid on DEBUGGING builds", 5); } @@ -793,7 +848,7 @@ else { my $warning = $test->{'warning'}; undef @warnings; - BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' } + use warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment); is($ret->[0], 0, "returned value $display; warnings enabled"); is($ret->[1], -1, "returned length $display; warnings enabled"); @@ -803,7 +858,7 @@ else { . "; Got: '$all_warnings', which should contain '$warning'"); undef @warnings; - BEGIN { 'warnings'->unimport('utf8') if "$]" > '5.006' } + no warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment); is($ret->[0], 0xFFFD, "returned value $display; warnings disabled"); is($ret->[1], $test->{'no_warnings_returned_length'}, @@ -811,8 +866,8 @@ else { } } -if ("$]" ge '5.008') { - BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } } +if (ivers($]) ge ivers(5.008)) { + BEGIN { if (ivers($]) ge ivers(5.008)) { require utf8; "utf8"->import() } } is(Devel::PPPort::sv_len_utf8("aščť"), 4); is(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4); @@ -847,7 +902,7 @@ if ("$]" ge '5.008') { is(tied($scalar)->{fetch}, 3); is(tied($scalar)->{store}, 0); } else { - skip 'skip: no SV_NOSTEAL support', 23; + skip 'skip: no utf8::downgrade/utf8::upgrade support', 23; } package TieScalarCounter; @@ -858,7 +913,7 @@ sub TIESCALAR { } sub FETCH { - BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } } + BEGIN { if (main::ivers($]) ge main::ivers(5.008)) { require utf8; "utf8"->import() } } my ($self) = @_; $self->{fetch}++; return $self->{value} .= "é"; diff --git a/dist/Devel-PPPort/parts/inc/variables b/dist/Devel-PPPort/parts/inc/variables index 0165a656a5..cc984c852b 100644 --- a/dist/Devel-PPPort/parts/inc/variables +++ b/dist/Devel-PPPort/parts/inc/variables @@ -18,6 +18,7 @@ PL_DBsingle PL_DBsub PL_DBtrace PL_Sv +PL_Xpv PL_bufend PL_bufptr PL_compiling @@ -98,6 +99,7 @@ __NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT; # define PL_DBsub DBsub # define PL_DBtrace DBtrace # define PL_Sv Sv +# define PL_Xpv Xpv # define PL_bufend bufend # define PL_bufptr bufptr # define PL_compiling compiling diff --git a/dist/Devel-PPPort/parts/ppport.fnc b/dist/Devel-PPPort/parts/ppport.fnc index 9938c41de9..4d34f77499 100644 --- a/dist/Devel-PPPort/parts/ppport.fnc +++ b/dist/Devel-PPPort/parts/ppport.fnc @@ -16,8 +16,8 @@ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: : : This file lists all API functions/macros that are provided purely -: by Devel::PPPort, or that are unXXX It is in the same format as the F<embed.fnc> that -: ships with the Perl source code. +: by Devel::PPPort, or that are not public. It is in the same format as the +: F<embed.fnc> that ships with the Perl source code. : : Since these are used only to provide the argument types, it's ok to have the : return value be void for some where it's an issues @@ -36,9 +36,8 @@ Amn|void|GV_NOADD_MASK Amn|void|IN_PERL_COMPILETIME Amn|void|NOOP Amn|void|PERL_BCDVERSION -Amn|void|PERL_LOADMOD_DENY -Amn|void|PERL_LOADMOD_IMPORT_OPS -Amn|void|PERL_LOADMOD_NOIMPORT +Amn|void|Perl_eval_pv +Amn|void|Perl_eval_sv Amn|void|PERL_MAGIC_glob Amn|void|PERL_MAGIC_mutex Amn|void|PERL_MAGIC_overload @@ -88,12 +87,12 @@ Amn|void|PL_sv_arenaroot Amn|void|PL_tainted Amn|void|PL_tainting Amn|void|PL_tokenbuf +Amn|void|PL_Xpv Amn|void|PTRV Amn|void|SAVE_DEFSV Amn|void|START_EXTERN_C Amn|void|SV_CONST_RETURN Amn|void|SV_COW_SHARED_HASH_KEYS -Amn|void|SVf Am|void|sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name|I32 namlen Amn|void|SV_MUTABLE_RETURN Amn|void|SV_UTF8_NO_ENCODING diff --git a/dist/Devel-PPPort/parts/todo/5003007 b/dist/Devel-PPPort/parts/todo/5003007 index 7969c270a5..fc87a0c321 100644 --- a/dist/Devel-PPPort/parts/todo/5003007 +++ b/dist/Devel-PPPort/parts/todo/5003007 @@ -108,6 +108,7 @@ grok_numeric_radix # T grok_oct # T G_SCALAR # T GV_ADD # T +GV_ADDMULTI # T GvAV # T gv_AVadd # T gv_check # T @@ -248,6 +249,7 @@ load_module # T LONGSIZE # T looks_like_number # T MARK # T +memCHRs # T memEQ # T memEQs # T memNE # T @@ -332,6 +334,8 @@ newSVpvs_share # T newSVREF # T newSVrv # T newSVsv # T +newSVsv_flags # T +newSVsv_nomg # T newSV_type # T newSVuv # T newUNOP # T @@ -349,11 +353,13 @@ NVef # T NVff # T NVgf # T NVTYPE # T +OPf_KIDS # T op_free # T OpHAS_SIBLING # T OpLASTSIB_set # T OpMAYBESIB_set # T OpMORESIB_set # T +OPpENTERSUB_AMPER # T OpSIBLING # T ORIGMARK # T OSNAME # T @@ -362,6 +368,8 @@ PERL_ABS # T perl_alloc # T PERL_BCDVERSION # T perl_construct # T +Perl_eval_pv # T +Perl_eval_sv # T perl_free # T PERL_HASH # T PERL_INT_MAX # T @@ -517,6 +525,7 @@ PL_sv_yes # T PL_tainted # T PL_tainting # T PL_tokenbuf # T +PL_Xpv # T Poison # T PoisonFree # T PoisonNew # T @@ -652,6 +661,7 @@ SvIOKp # T sv_isa # T sv_isobject # T SvIV # T +SvIV_nomg # T SvIV_set # T SvIVX # T SvIVx # T @@ -661,6 +671,7 @@ SvLEN_set # T sv_magic # T SvMAGIC_set # T sv_mortalcopy # T +sv_mortalcopy_flags # T SV_MUTABLE_RETURN # T sv_newmortal # T sv_newref # T @@ -672,7 +683,9 @@ SvNOK_off # T SvNOK_on # T SvNOK_only # T SvNOKp # T +SV_NOSTEAL # T SvNV # T +SvNV_nomg # T SvNV_set # T SvNVX # T SvNVx # T @@ -735,6 +748,7 @@ sv_setref_pv # T sv_setref_pvn # T sv_setsv # T SvSetSV # T +sv_setsv_flags # T sv_setsv_mg # T sv_setsv_nomg # T sv_setuv # T @@ -759,6 +773,7 @@ SVt_PVLV # T SVt_PVMG # T SVt_PVNV # T SvTRUE # T +SvTRUE_nomg # T SvTRUEx # T SvTYPE # T sv_unmagic # T @@ -768,9 +783,11 @@ sv_upgrade # T SvUPGRADE # T sv_usepvn # T sv_usepvn_mg # T +SvUTF8 # T SV_UTF8_NO_ENCODING # T sv_uv # T SvUV # T +SvUV_nomg # T SvUV_set # T SvUVX # T SvUVx # T @@ -786,6 +803,8 @@ UNICODE_REPLACEMENT # T UNI_TO_NATIVE # T UNLIKELY # T unsharepvn # T +UTF8f # T +UTF8fARG # T UTF8_IS_INVARIANT # T UTF8_MAXBYTES_CASE # T UVCHR_IS_INVARIANT # T diff --git a/dist/Devel-PPPort/parts/todo/5004005 b/dist/Devel-PPPort/parts/todo/5004005 index fe2fc1b5b7..fe3666b7e7 100644 --- a/dist/Devel-PPPort/parts/todo/5004005 +++ b/dist/Devel-PPPort/parts/todo/5004005 @@ -1,4 +1,5 @@ 5.004005 do_binmode # U +GV_NOINIT # E save_aelem # U save_helem # U diff --git a/dist/Devel-PPPort/parts/todo/5006000 b/dist/Devel-PPPort/parts/todo/5006000 index 0cbe62f335..7785939ec2 100644 --- a/dist/Devel-PPPort/parts/todo/5006000 +++ b/dist/Devel-PPPort/parts/todo/5006000 @@ -99,6 +99,8 @@ newATTRSUB # U newXS # E (Perl_newXS) newXSproto # E op_dump # U +OPpEARLY_CV # E +PERL_EXIT_EXPECTED # E perl_parse # E (perl_parse) PERL_SYS_INIT3 # U PL_check # E @@ -150,7 +152,6 @@ SvPVutf8x # U SvPVutf8x_force # U sv_rvweaken # U SvUOK # U -SvUTF8 # U sv_utf8_decode # U sv_utf8_downgrade # U sv_utf8_encode # U diff --git a/dist/Devel-PPPort/parts/todo/5007001 b/dist/Devel-PPPort/parts/todo/5007001 index 299ea8d871..de1e84e7b5 100644 --- a/dist/Devel-PPPort/parts/todo/5007001 +++ b/dist/Devel-PPPort/parts/todo/5007001 @@ -27,6 +27,7 @@ sv_force_normal_flags # U sv_setref_uv # U sv_unref_flags # U sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) +UTF8_CHECK_ONLY # E utf8_length # U utf8n_to_uvchr # U uvchr_to_utf8 # U diff --git a/dist/Devel-PPPort/parts/todo/5007002 b/dist/Devel-PPPort/parts/todo/5007002 index d7507879d9..e763ce3c1c 100644 --- a/dist/Devel-PPPort/parts/todo/5007002 +++ b/dist/Devel-PPPort/parts/todo/5007002 @@ -8,13 +8,10 @@ malloc # U mfree # U mini_mktime # U my_strftime # U -newSVsv_flags # U op_null # U OSVERS # E realloc # U sv_catpvn_flags # U sv_catsv_flags # U -sv_mortalcopy_flags # U -sv_setsv_flags # U sv_utf8_upgrade_flags # U sv_utf8_upgrade_nomg # U diff --git a/dist/Devel-PPPort/parts/todo/5007003 b/dist/Devel-PPPort/parts/todo/5007003 index 999b2b5cf5..164ecfd1bb 100644 --- a/dist/Devel-PPPort/parts/todo/5007003 +++ b/dist/Devel-PPPort/parts/todo/5007003 @@ -19,10 +19,10 @@ ibcmp_utf8 # U mg_dup # E (Perl_mg_dup) my_fork # U my_socketpair # U -newSVsv_nomg # U OP_DESC # U OP_NAME # U perl_destruct # E (perl_destruct) +PERL_EXIT_DESTRUCT_END # E PerlIO_clearerr # U (PerlIO_clearerr) PerlIO_close # U (PerlIO_close) PerlIO_eof # U (PerlIO_eof) @@ -55,20 +55,15 @@ sortsv # U ss_dup # E (Perl_ss_dup) sv_copypv # U sv_dup # E (Perl_sv_dup) -SvIV_nomg # U SvLOCK # U sv_magicext # U sv_nolocking # U sv_nosharing # U -SV_NOSTEAL # E sv_nounlocking # U -SvNV_nomg # U sv_recode_to_utf8 # U SvSHARE # U -SvTRUE_nomg # U sv_uni_display # U SvUNLOCK # U -SvUV_nomg # U unpack_str # U uvchr_to_utf8_flags # U vdeb # U diff --git a/dist/Devel-PPPort/parts/todo/5008000 b/dist/Devel-PPPort/parts/todo/5008000 index d7942a3e7e..13cc7f2d87 100644 --- a/dist/Devel-PPPort/parts/todo/5008000 +++ b/dist/Devel-PPPort/parts/todo/5008000 @@ -1,5 +1,6 @@ 5.008000 HeUTF8 # U hv_iternext_flags # U +HV_ITERNEXT_WANTPLACEHOLDERS # E hv_store_flags # U nothreadhook # U diff --git a/dist/Devel-PPPort/parts/todo/5009000 b/dist/Devel-PPPort/parts/todo/5009000 index d8e316d895..ecbaf1d3d5 100644 --- a/dist/Devel-PPPort/parts/todo/5009000 +++ b/dist/Devel-PPPort/parts/todo/5009000 @@ -13,6 +13,7 @@ parser_dup # U pMY_CXT # E regdupe_internal # U save_set_svflags # U +SVs_PADSTALE # E vcmp # U vnumify # U vstringify # U diff --git a/dist/Devel-PPPort/parts/todo/5009003 b/dist/Devel-PPPort/parts/todo/5009003 index 5fcebbe6c9..529dc08bee 100644 --- a/dist/Devel-PPPort/parts/todo/5009003 +++ b/dist/Devel-PPPort/parts/todo/5009003 @@ -5,6 +5,8 @@ ckwarn_d # U dMULTICALL # E doref # U gv_const_sv # U +GV_NOADD_NOINIT # E +GV_NOEXPAND # E hv_eiter_p # U hv_eiter_set # U hv_name_set # U diff --git a/dist/Devel-PPPort/parts/todo/5011002 b/dist/Devel-PPPort/parts/todo/5011002 index d81ac6482f..906e256dce 100644 --- a/dist/Devel-PPPort/parts/todo/5011002 +++ b/dist/Devel-PPPort/parts/todo/5011002 @@ -5,6 +5,7 @@ LEAVE_with_name # U lex_bufutf8 # U lex_discard_to # U lex_grow_linestr # U +LEX_KEEP_PREVIOUS # E lex_next_chunk # U lex_peek_unichar # U lex_read_space # U @@ -12,5 +13,6 @@ lex_read_to # U lex_read_unichar # U lex_stuff_pvn # U lex_stuff_sv # U +LEX_STUFF_UTF8 # E lex_unstuff # U PL_keyword_plugin # E diff --git a/dist/Devel-PPPort/parts/todo/5013006 b/dist/Devel-PPPort/parts/todo/5013006 index 589a952ed4..49dbd4354b 100644 --- a/dist/Devel-PPPort/parts/todo/5013006 +++ b/dist/Devel-PPPort/parts/todo/5013006 @@ -16,6 +16,8 @@ op_prepend_elem # U parse_stmtseq # U PERL_MAGIC_checkcall # E rv2cv_op_cv # U +RV2CVOPCV_MARK_EARLY # E +RV2CVOPCV_RETURN_NAME_GV # E savesharedpvs # U savesharedsvpv # U sv_2bool_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5013007 b/dist/Devel-PPPort/parts/todo/5013007 index 1685d47035..8b9162e06e 100644 --- a/dist/Devel-PPPort/parts/todo/5013007 +++ b/dist/Devel-PPPort/parts/todo/5013007 @@ -12,6 +12,7 @@ cophh_fetch_pvn # E cophh_fetch_pvs # E cophh_fetch_sv # E cophh_free # E +COPHH_KEY_UTF8 # E cophh_new_empty # E cophh_store_pv # E cophh_store_pvn # E @@ -33,6 +34,8 @@ op_scope # U parse_barestmt # U parse_block # U parse_label # U +PARSE_OPTIONAL # E +PL_phase # E XopFLAGS # E XopDISABLE # X added by devel/scanprov XopENABLE # X added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/todo/5013009 b/dist/Devel-PPPort/parts/todo/5013009 index 0d61e4332e..45c9725025 100644 --- a/dist/Devel-PPPort/parts/todo/5013009 +++ b/dist/Devel-PPPort/parts/todo/5013009 @@ -1,2 +1,10 @@ 5.013009 PERL_PV_ESCAPE_NONASCII # E +UTF8_DISALLOW_ILLEGAL_INTERCHANGE # E +UTF8_DISALLOW_NONCHAR # E +UTF8_DISALLOW_SUPER # E +UTF8_DISALLOW_SURROGATE # E +UTF8_WARN_ILLEGAL_INTERCHANGE # E +UTF8_WARN_NONCHAR # E +UTF8_WARN_SUPER # E +UTF8_WARN_SURROGATE # E diff --git a/dist/Devel-PPPort/parts/todo/5015003 b/dist/Devel-PPPort/parts/todo/5015003 index 7f33df7128..20e036eee5 100644 --- a/dist/Devel-PPPort/parts/todo/5015003 +++ b/dist/Devel-PPPort/parts/todo/5015003 @@ -1 +1,2 @@ 5.015003 +GV_ADDMG # E diff --git a/dist/Devel-PPPort/parts/todo/5019001 b/dist/Devel-PPPort/parts/todo/5019001 index b61335b150..06927ae6fa 100644 --- a/dist/Devel-PPPort/parts/todo/5019001 +++ b/dist/Devel-PPPort/parts/todo/5019001 @@ -2,4 +2,3 @@ toFOLD # U toLOWER_L1 # U toTITLE # U -UTF8f # E diff --git a/dist/Devel-PPPort/parts/todo/5019002 b/dist/Devel-PPPort/parts/todo/5019002 index d709ed410f..9fcc71ef9e 100644 --- a/dist/Devel-PPPort/parts/todo/5019002 +++ b/dist/Devel-PPPort/parts/todo/5019002 @@ -1,3 +1,2 @@ 5.019002 G_METHOD_NAMED # E -UTF8fARG # U diff --git a/dist/Devel-PPPort/parts/todo/5019003 b/dist/Devel-PPPort/parts/todo/5019003 index 4bcc1d17f8..a6403ca53a 100644 --- a/dist/Devel-PPPort/parts/todo/5019003 +++ b/dist/Devel-PPPort/parts/todo/5019003 @@ -1,2 +1,4 @@ 5.019003 +PERL_EXIT_ABORT # E +PERL_EXIT_WARN # E sv_pos_b2u_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5021004 b/dist/Devel-PPPort/parts/todo/5021004 index 211c72c722..4a209c3338 100644 --- a/dist/Devel-PPPort/parts/todo/5021004 +++ b/dist/Devel-PPPort/parts/todo/5021004 @@ -1,4 +1,5 @@ 5.021004 +CALL_CHECKER_REQUIRE_GV # E cv_set_call_checker_flags # U grok_infnan # U isinfnan # U diff --git a/dist/Devel-PPPort/parts/todo/5021005 b/dist/Devel-PPPort/parts/todo/5021005 index ddfe99f722..2e5af874bb 100644 --- a/dist/Devel-PPPort/parts/todo/5021005 +++ b/dist/Devel-PPPort/parts/todo/5021005 @@ -1,7 +1,10 @@ 5.021005 cv_name # A +CV_NAME_NOTQUAL # E newMETHOP # U newMETHOP_named # U PERL_MAGIC_debugvar # E PERL_MAGIC_lvref # E +SV_CATBYTES # E +SV_CATUTF8 # E WARN_EXPERIMENTAL__REFALIASING # E diff --git a/dist/Devel-PPPort/parts/todo/5021007 b/dist/Devel-PPPort/parts/todo/5021007 index dfee4f1a47..485119b6ce 100644 --- a/dist/Devel-PPPort/parts/todo/5021007 +++ b/dist/Devel-PPPort/parts/todo/5021007 @@ -9,3 +9,4 @@ PadnamelistREFCNT_dec # U padnamelist_store # U PadnameREFCNT # U PadnameREFCNT_dec # U +PADNAMEt_OUTER # E diff --git a/dist/Devel-PPPort/parts/todo/5025005 b/dist/Devel-PPPort/parts/todo/5025005 index bff264b62e..ab5b700990 100644 --- a/dist/Devel-PPPort/parts/todo/5025005 +++ b/dist/Devel-PPPort/parts/todo/5025005 @@ -4,3 +4,5 @@ isSTRICT_UTF8_CHAR # U isUTF8_CHAR_flags # U is_utf8_valid_partial_char # U is_utf8_valid_partial_char_flags # U +UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE # E +UTF8_WARN_ILLEGAL_C9_INTERCHANGE # E diff --git a/dist/Devel-PPPort/parts/todo/5027002 b/dist/Devel-PPPort/parts/todo/5027002 index 68515e4456..4e50daeff0 100644 --- a/dist/Devel-PPPort/parts/todo/5027002 +++ b/dist/Devel-PPPort/parts/todo/5027002 @@ -1,2 +1,4 @@ 5.027002 Perl_setlocale # U +UTF8_DISALLOW_PERL_EXTENDED # E +UTF8_WARN_PERL_EXTENDED # E diff --git a/dist/Devel-PPPort/parts/todo/5031007 b/dist/Devel-PPPort/parts/todo/5031007 index d71ccfa4ea..0cd061b015 100644 --- a/dist/Devel-PPPort/parts/todo/5031007 +++ b/dist/Devel-PPPort/parts/todo/5031007 @@ -3,3 +3,5 @@ csighandler # E (Perl_csighandler) csighandler1 # U csighandler3 # E perly_sighandler # E +sv_isa_sv # U +WARN_EXPERIMENTAL__ISA # E diff --git a/dist/Devel-PPPort/parts/todo/5031008 b/dist/Devel-PPPort/parts/todo/5031008 new file mode 100644 index 0000000000..f24c040a9c --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5031008 @@ -0,0 +1 @@ +5.031008 diff --git a/dist/Devel-PPPort/t/Sv_set.t b/dist/Devel-PPPort/t/Sv_set.t index e56e67ed9f..821cf01fcc 100644 --- a/dist/Devel-PPPort/t/Sv_set.t +++ b/dist/Devel-PPPort/t/Sv_set.t @@ -65,10 +65,12 @@ is($bar->x(), 'foobar'); Devel::PPPort::TestSvSTASH_set($bar, 'bar'); is($bar->x(), 'hacker'); -if ( "$]" < '5.007003' ) { - skip 'skip: no SV_NOSTEAL support', 10; -} else { - ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL()); + if (ivers($]) != ivers(5.7.2)) { + ok(Devel::PPPort::Test_sv_setsv_SV_NOSTEAL()); + } + else { + skip("7.2 broken for NOSTEAL", 1); + } tie my $scalar, 'TieScalarCounter', 'string'; @@ -85,7 +87,6 @@ if ( "$]" < '5.007003' ) { is tied($scalar)->{fetch}, 1; is tied($scalar)->{store}, 0; is $copy2, 'string'; -} package TieScalarCounter; diff --git a/dist/Devel-PPPort/t/call.t b/dist/Devel-PPPort/t/call.t index 8b68428f93..c26a5a6ec9 100644 --- a/dist/Devel-PPPort/t/call.t +++ b/dist/Devel-PPPort/t/call.t @@ -34,9 +34,9 @@ BEGIN { require 'inctools'; } - if (86) { + if (88) { load(); - plan(tests => 86); + plan(tests => 88); } } @@ -113,6 +113,7 @@ ok(eval { $@ = 'string1'; Devel::PPPort::eval_pv('$@ = "string2"', 1); 1 }); ok(eval { $@ = 'string1'; Devel::PPPort::eval_pv('$@ = "string2"; die "string3"', 0); 1 }); ok(!eval { $@ = 'string1'; Devel::PPPort::eval_pv('$@ = "string2"; die "string3"', 1); 1 }); ok($@ =~ /^string3 at \(eval [0-9]+\) line 1\.\n$/); +ok(!eval { Devel::PPPort::eval_pv('die False->new', 1); 1 }, 'check false value is rethrown'); if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) { my $hashref = { key => 'value' }; @@ -139,6 +140,7 @@ ok(eval { $@ = 'string1'; Devel::PPPort::eval_sv('$@ = "string2"', &Devel::PPPor ok(eval { $@ = 'string1'; Devel::PPPort::eval_sv('$@ = "string2"; die "string3"', 0); 1 }); ok(!eval { $@ = 'string1'; Devel::PPPort::eval_sv('$@ = "string2"; die "string3"', &Devel::PPPort::G_RETHROW); 1 }); ok($@ =~ /^string3 at \(eval [0-9]+\) line 1\.\n$/); +ok(!eval { Devel::PPPort::eval_sv('die False->new', &Devel::PPPort::G_RETHROW); 1 }, 'check false value is rethrown'); if ("$]" >= '5.007003' or ("$]" >= '5.006001' and "$]" < '5.007')) { my $hashref = { key => 'value' }; diff --git a/dist/Devel-PPPort/t/format.t b/dist/Devel-PPPort/t/format.t index db8386809b..ef471e0960 100644 --- a/dist/Devel-PPPort/t/format.t +++ b/dist/Devel-PPPort/t/format.t @@ -68,12 +68,13 @@ is(Devel::PPPort::sprintf_iv(-8), 'XX_-8_XX'); is(Devel::PPPort::sprintf_uv(15), 'XX_15_XX'); my $ivsize = $Config::Config{ivsize}; -my $ivmax = ($ivsize == 4) ? '2147483647' : ($ivsize == 8) ? '9223372036854775807' : 0; -my $uvmax = ($ivsize == 4) ? '4294967295' : ($ivsize == 8) ? '18446744073709551615' : 0; -if ($ivmax == 0) { - skip 'skip: unknown ivsize', 2; -} else { +if ($ivsize && ($ivsize == 4 || $ivsize == 8)) { + my $ivmax = ($ivsize == 4) ? '2147483647' : '9223372036854775807'; + my $uvmax = ($ivsize == 4) ? '4294967295' : '18446744073709551615'; is(Devel::PPPort::sprintf_ivmax(), $ivmax); is(Devel::PPPort::sprintf_uvmax(), $uvmax); } +else { + skip 'skip: unknown ivsize', 2; +} diff --git a/dist/Devel-PPPort/t/magic.t b/dist/Devel-PPPort/t/magic.t index 973f7f6ee6..471c4853ae 100644 --- a/dist/Devel-PPPort/t/magic.t +++ b/dist/Devel-PPPort/t/magic.t @@ -34,9 +34,9 @@ BEGIN { require 'inctools'; } - if (45) { + if (63) { load(); - plan(tests => 45); + plan(tests => 63); } } @@ -122,9 +122,6 @@ my $foo = 'bar'; ok(Devel::PPPort::sv_magic_portable($foo)); ok($foo eq 'bar'); -if ( "$]" < '5.007003' ) { - skip 'skip: no SV_NOSTEAL support', 22; -} else { tie my $scalar, 'TieScalarCounter', 10; my $fetch = $scalar; @@ -153,7 +150,50 @@ if ( "$]" < '5.007003' ) { is Devel::PPPort::magic_SvNV_nomg($object), 5.5; is Devel::PPPort::magic_SvPV_nomg_nolen($object), 'string'; ok !Devel::PPPort::magic_SvTRUE_nomg($object); + +tie my $negative, 'TieScalarCounter', -1; +$fetch = $negative; + +is tied($negative)->{fetch}, 1; +is tied($negative)->{store}, 0; +is Devel::PPPort::magic_SvIV_nomg($negative), -1; +if (ivers($]) >= ivers(5.6)) { + ok !Devel::PPPort::SVf_IVisUV($negative); +} else { + skip 'SVf_IVisUV is unsupported', 1; +} +is tied($negative)->{fetch}, 1; +is tied($negative)->{store}, 0; +Devel::PPPort::magic_SvUV_nomg($negative); +if (ivers($]) >= ivers(5.6)) { + ok !Devel::PPPort::SVf_IVisUV($negative); +} else { + skip 'SVf_IVisUV is unsupported', 1; +} +is tied($negative)->{fetch}, 1; +is tied($negative)->{store}, 0; + +tie my $big, 'TieScalarCounter', Devel::PPPort::above_IV_MAX(); +$fetch = $big; + +is tied($big)->{fetch}, 1; +is tied($big)->{store}, 0; +Devel::PPPort::magic_SvIV_nomg($big); +if (ivers($]) >= ivers(5.6)) { + ok Devel::PPPort::SVf_IVisUV($big); +} else { + skip 'SVf_IVisUV is unsupported', 1; +} +is tied($big)->{fetch}, 1; +is tied($big)->{store}, 0; +is Devel::PPPort::magic_SvUV_nomg($big), Devel::PPPort::above_IV_MAX(); +if (ivers($]) >= ivers(5.6)) { + ok Devel::PPPort::SVf_IVisUV($big); +} else { + skip 'SVf_IVisUV is unsupported', 1; } +is tied($big)->{fetch}, 1; +is tied($big)->{store}, 0; package TieScalarCounter; diff --git a/dist/Devel-PPPort/t/misc.t b/dist/Devel-PPPort/t/misc.t index 3f868c01e2..6901a19ab9 100644 --- a/dist/Devel-PPPort/t/misc.t +++ b/dist/Devel-PPPort/t/misc.t @@ -54,30 +54,30 @@ package main; use vars qw($my_sv @my_av %my_hv); -ok(&Devel::PPPort::boolSV(1)); -ok(!&Devel::PPPort::boolSV(0)); +ok(&Devel::PPPort::boolSV(1), "Verify boolSV(1) is true"); +ok(!&Devel::PPPort::boolSV(0), "Verify boolSV(0) is false"); $_ = "Fred"; -is(&Devel::PPPort::DEFSV(), "Fred"); -is(&Devel::PPPort::UNDERBAR(), "Fred"); +is(&Devel::PPPort::DEFSV(), "Fred", '$_ is FRED; Verify DEFSV is FRED'); +is(&Devel::PPPort::UNDERBAR(), "Fred", 'And verify UNDERBAR is FRED'); if (ivers($]) >= ivers(5.9.2) && ivers($]) < ivers(5.23)) { eval q{ no warnings "deprecated"; - no if $^V > v5.17.9, warnings => "experimental::lexical_topic"; + no if $^V >= v5.17.9, warnings => "experimental::lexical_topic"; my $_ = "Tony"; - is(&Devel::PPPort::DEFSV(), "Fred"); - is(&Devel::PPPort::UNDERBAR(), "Tony"); + is(&Devel::PPPort::DEFSV(), "Fred", 'lexical_topic eval: $_ is Tony; Verify DEFSV is Fred'); + is(&Devel::PPPort::UNDERBAR(), "Tony", 'And verify UNDERBAR is Tony'); }; + die __FILE__ . __LINE__ . ": $@" if $@; } else { - ok(1); - ok(1); + skip("perl version outside testing range of lexical_topic", 2); } my @r = &Devel::PPPort::DEFSV_modify(); -ok(@r == 3); +ok(@r == 3, "Verify got 3 elements"); is($r[0], 'Fred'); is($r[1], 'DEFSV'); is($r[2], 'Fred'); @@ -85,9 +85,9 @@ is($r[2], 'Fred'); is(&Devel::PPPort::DEFSV(), "Fred"); eval { 1 }; -ok(!&Devel::PPPort::ERRSV()); +ok(!&Devel::PPPort::ERRSV(), "Verify ERRSV on true is false"); eval { cannot_call_this_one() }; -ok(&Devel::PPPort::ERRSV()); +ok(&Devel::PPPort::ERRSV(), "Verify ERRSV on false is true"); ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); @@ -121,8 +121,8 @@ is(Devel::PPPort::prepush(), 42); is(join(':', Devel::PPPort::xsreturn(0)), 'test1'); is(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); -is(Devel::PPPort::PERL_ABS(42), 42); -is(Devel::PPPort::PERL_ABS(-13), 13); +is(Devel::PPPort::PERL_ABS(42), 42, "Verify PERL_ABS(42) is 42"); +is(Devel::PPPort::PERL_ABS(-13), 13, "Verify PERL_ABS(-13) is 13"); is(Devel::PPPort::SVf(42), ivers($]) >= ivers(5.4) ? '[42]' : '42'); is(Devel::PPPort::SVf('abc'), ivers($]) >= ivers(5.4) ? '[abc]' : 'abc'); @@ -153,7 +153,7 @@ if (ivers($]) < ivers(5.5)) { skip 'no qr// objects in this perl', 2; } else { my $qr = eval 'qr/./'; - ok(Devel::PPPort::SvRXOK($qr)); + ok(Devel::PPPort::SvRXOK($qr), "SVRXOK(qr) is true"); ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise")); } @@ -162,7 +162,7 @@ ok( Devel::PPPort::NATIVE_TO_LATIN1(0x1) == 0x1); ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("A")) == 0x41); ok( Devel::PPPort::NATIVE_TO_LATIN1(ord("0")) == 0x30); -ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6); +ok( Devel::PPPort::LATIN1_TO_NATIVE(0xB6) == 0xB6, "Verify LATIN1_TO_NATIVE(0xB6) is 0xB6"); if (ord("A") == 65) { ok( Devel::PPPort::LATIN1_TO_NATIVE(0x41) == 0x41); ok( Devel::PPPort::LATIN1_TO_NATIVE(0x30) == 0x30); @@ -176,14 +176,14 @@ ok( Devel::PPPort::isALNUMC_L1(ord("5"))); ok( Devel::PPPort::isALNUMC_L1(0xFC)); ok(! Devel::PPPort::isALNUMC_L1(0xB6)); -ok( Devel::PPPort::isOCTAL(ord("7"))); -ok(! Devel::PPPort::isOCTAL(ord("8"))); +ok( Devel::PPPort::isOCTAL(ord("7")), "Verify '7' is OCTAL"); +ok(! Devel::PPPort::isOCTAL(ord("8")), "Verify '8' isn't OCTAL"); -ok( Devel::PPPort::isOCTAL_A(ord("0"))); -ok(! Devel::PPPort::isOCTAL_A(ord("9"))); +ok( Devel::PPPort::isOCTAL_A(ord("0")), "Verify '0' is OCTAL_A"); +ok(! Devel::PPPort::isOCTAL_A(ord("9")), "Verify '9' isn't OCTAL_A"); -ok( Devel::PPPort::isOCTAL_L1(ord("2"))); -ok(! Devel::PPPort::isOCTAL_L1(ord("8"))); +ok( Devel::PPPort::isOCTAL_L1(ord("2")), "Verify '2' is OCTAL_L1"); +ok(! Devel::PPPort::isOCTAL_L1(ord("8")), "Verify '8' isn't OCTAL_L1"); my $way_too_early_msg = 'UTF-8 not implemented on this perl'; @@ -283,7 +283,7 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { XDIGIT)) { if ($i < 256) { # For the ones that can fit in a byte, test each of - #three macros. + # three macros. my $suffix; for $suffix ("", "_A", "_L1", "_uvchr") { my $should_be = ($i > 0x7F && $suffix !~ /_(uvchr|L1)/) @@ -295,6 +295,7 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } my $eval_string = "Devel::PPPort::is${class}$suffix($hex)"; + local $SIG{__WARN__} = sub {}; my $is = eval $eval_string || 0; die "eval 'For $i: $eval_string' gave $@" if $@; is($is, $should_be, "'$eval_string'"); @@ -324,10 +325,10 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { skip $skip, 1; } else { - $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($i); + $utf8 = quotemeta Devel::PPPort::uvchr_to_utf8($native); my $should_be = $types{"$native:$class"} || 0; - local $SIG{__WARN__} = sub {}; my $eval_string = "$fcn(\"$utf8\", 0)"; + local $SIG{__WARN__} = sub {}; my $is = eval $eval_string || 0; die "eval 'For $i, $eval_string' gave $@" if $@; is($is, $should_be, sprintf("For U+%04X '%s'", $native, $eval_string)); @@ -344,7 +345,8 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } else { my $eval_string = "$fcn(\"$utf8\", -1)"; - my $is = eval "no warnings; $eval_string" || 0; + local $SIG{__WARN__} = sub {}; + my $is = eval "$eval_string" || 0; die "eval '$eval_string' gave $@" if $@; is($is, 0, sprintf("For U+%04X '%s'", $native, $eval_string)); } @@ -354,23 +356,30 @@ for $i (sort { $a <=> $b } keys %code_points_to_test) { } my %case_changing = ( 'LOWER' => [ [ ord('A'), ord('a') ], - [ 0xC0, 0xE0 ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0), + Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ], [ 0x100, 0x101 ], ], 'FOLD' => [ [ ord('C'), ord('c') ], - [ 0xC0, 0xE0 ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xC0), + Devel::PPPort::LATIN1_TO_NATIVE(0xE0) ], [ 0x104, 0x105 ], - [ 0xDF, 'ss' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'ss' ], ], - 'UPPER' => [ [ ord('a'),ord('A'), ], - [ 0xE0, 0xC0 ], + 'UPPER' => [ [ ord('a'), ord('A'), ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xE0), + Devel::PPPort::LATIN1_TO_NATIVE(0xC0) ], [ 0x101, 0x100 ], - [ 0xDF, 'SS' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'SS' ], ], - 'TITLE' => [ [ ord('c'),ord('C'), ], - [ 0xE2, 0xC2 ], + 'TITLE' => [ [ ord('c'), ord('C'), ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xE2), + Devel::PPPort::LATIN1_TO_NATIVE(0xC2) ], [ 0x103, 0x102 ], - [ 0xDF, 'Ss' ], + [ Devel::PPPort::LATIN1_TO_NATIVE(0xDF), + 'Ss' ], ], ); @@ -387,11 +396,11 @@ for $name (keys %case_changing) { my $should_be_bytes; if (ivers($]) >= ivers(5.6)) { if ($is_cp) { - $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed); + $utf8_changed = Devel::PPPort::uvchr_to_utf8($changed); $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0); } else { - die("Test currently doesn't work for non-ASCII multi-char case changes") if $utf8_changed =~ /[[:^ascii:]]/; + die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /[[:^ascii:]]/'; $should_be_bytes = length $utf8_changed; } } @@ -410,11 +419,12 @@ for $name (keys %case_changing) { } else { if ($is_cp) { - $utf8_changed = Devel::PPPort::uvoffuni_to_utf8($changed); + $utf8_changed = Devel::PPPort::uvchr_to_utf8($changed); $should_be_bytes = Devel::PPPort::UTF8_SAFE_SKIP($utf8_changed, 0); } else { - die("Test currently doesn't work for non-ASCII multi-char case changes") if $utf8_changed =~ /[[:^ascii:]]/; + my $non_ascii_re = (ivers($]) >= ivers(5.6)) ? '[[:^ascii:]]' : '[^\x00-\x7F]'; + die("Test currently doesn't work for non-ASCII multi-char case changes") if eval '$utf8_changed =~ /$non_ascii_re/'; $should_be_bytes = length $utf8_changed; } @@ -455,7 +465,7 @@ for $name (keys %case_changing) { } else { my $fcn = "to${name}_utf8_safe"; - my $utf8 = quotemeta Devel::PPPort::uvoffuni_to_utf8($original); + my $utf8 = quotemeta Devel::PPPort::uvchr_to_utf8($original); my $real_truncate = ($truncate < 2) ? $truncate : $should_be_bytes; my $eval_string = "Devel::PPPort::$fcn(\"$utf8\", $real_truncate)"; diff --git a/dist/Devel-PPPort/t/podtest.t b/dist/Devel-PPPort/t/podtest.t index 98698ad73a..73173b4b9f 100644 --- a/dist/Devel-PPPort/t/podtest.t +++ b/dist/Devel-PPPort/t/podtest.t @@ -63,11 +63,11 @@ else { # Try loading Test::Pod eval q{ use Test::Pod; - $Test::Pod::VERSION >= 0.95 + $Test::Pod::VERSION >= 1.41 or die "Test::Pod version only $Test::Pod::VERSION"; import Test::Pod tests => scalar @pods; }; - $reason = 'Test::Pod >= 0.95 required' if $@; + $reason = 'Test::Pod >= 1.41 required' if $@; } if ($reason) { diff --git a/dist/Devel-PPPort/t/testutil.pl b/dist/Devel-PPPort/t/testutil.pl index 942d254ba7..981b659b3c 100644 --- a/dist/Devel-PPPort/t/testutil.pl +++ b/dist/Devel-PPPort/t/testutil.pl @@ -25,9 +25,14 @@ my $test = 1; my $planned; my $noplan; +# Fatalize warnings, so that we don't introduce new warnings. But on early +# perls the burden of avoiding warnings becomes too large, and someone still +# trying to use such outmoded versions should be willing to accept warnings in +# our test suite. +$SIG{__WARN__} = sub { die "Fatalized: $_[0]" } if $] ge "5.6.0"; + # This defines ASCII/UTF-8 vs EBCDIC/UTF-EBCDIC $::IS_ASCII = ord 'A' == 65; -$::IS_EBCDIC = ord 'A' == 193; $TODO = 0; $NO_ENDING = 0; @@ -195,7 +200,7 @@ sub _qq { # Support pre-5.10 Perls, for the benefit of CPAN dists that copy this file. # Note that chr(90) exists in both ASCII ("Z") and EBCDIC ("!"). -my $chars_template = defined(eval { pack "W*", 90 }) ? "W*" : "U*"; +my $chars_template = defined(eval { pack "W*", 90 }) ? "W*" : defined(eval { pack "U*", 90 }) ? "U*" : "C*"; eval 'sub re::is_regexp { ref($_[0]) eq "Regexp" }' if !defined &re::is_regexp; @@ -219,30 +224,32 @@ sub display { $y = $y . sprintf "\\x{%x}", $c; } elsif ($backslash_escape{$c}) { $y = $y . $backslash_escape{$c}; - } else { - my $z = chr $c; # Maybe we can get away with a literal... - my $is_printable = ($::IS_ASCII) - ? $c >= ord(" ") && $c <= ord("~") - : $z !~ /[^[:^print:][:^ascii:]]/; - # /[::]/ was introduced before non-ASCII support - # The pattern above is equivalent (by de Morgan's - # laws) to: - # $z !~ /(?[ [:print:] & [:ascii:] ])/ - # or, $z is not an ascii printable character - - unless ($is_printable) { - # Use octal for characters with small ordinals that - # are traditionally expressed as octal: the controls - # below space, which on EBCDIC are almost all the - # controls, but on ASCII don't include DEL nor the C1 - # controls. - if ($c < ord " ") { - $z = sprintf "\\%03o", $c; - } else { - $z = sprintf "\\x{%x}", $c; - } - } - $y = $y . $z; + } elsif ($c < ord " ") { + # Use octal for characters with small ordinals that are + # traditionally expressed as octal: the controls below + # space, which on EBCDIC are almost all the controls, but + # on ASCII don't include DEL nor the C1 controls. + $y = $y . sprintf "\\%03o", $c; + } elsif ($::IS_ASCII && $c <= ord('~')) { + $y = $y . chr $c; + } elsif ( ! $::IS_ASCII + && eval 'chr $c =~ /[^[:^print:][:^ascii:]]/') + # The pattern above is equivalent (by de Morgan's + # laws) to: + # $z =~ /(?[ [:print:] & [:ascii:] ])/ + # or, $z is an ascii printable character + # The /a modifier doesn't go back so far. + { + $y = $y . chr $c; + } + elsif ($@) { # Should only be an error on platforms too + # early to have the [:posix:] syntax, which + # also should be ASCII ones + die __FILE__ . __LINE__ + . ": Unexpected non-ASCII platform; $@"; + } + else { + $y = $y . sprintf "\\x%02X", $c; } } $x = $y; diff --git a/dist/Devel-PPPort/t/utf8.t b/dist/Devel-PPPort/t/utf8.t index 3ba2e8acf9..12a593e203 100644 --- a/dist/Devel-PPPort/t/utf8.t +++ b/dist/Devel-PPPort/t/utf8.t @@ -34,9 +34,9 @@ BEGIN { require 'inctools'; } - if (93) { + if (98) { load(); - plan(tests => 93); + plan(tests => 98); } } @@ -52,14 +52,25 @@ bootstrap Devel::PPPort; package main; -BEGIN { require warnings if "$]" > '5.006' } - -# skip tests on 5.6.0 and earlier, plus 7.0 -if ("$]" <= '5.006' || "$]" == '5.007' ) { - skip 'skip: broken utf8 support', 93; - exit; +BEGIN { + # skip tests on 5.6.0 and earlier, plus 5.7.0 + if (ivers($]) <= ivers(5.6) || ivers($]) == ivers(5.7) ) { + skip 'skip: broken utf8 support', 98; + exit; + } + require warnings; } +is(Devel::PPPort::UTF8f(42), '[42]'); +is(Devel::PPPort::UTF8f('abc'), '[abc]'); +is(Devel::PPPort::UTF8f("\x{263a}"), "[\x{263a}]"); + +my $str = "\x{A8}"; +if (ivers($]) >= ivers(5.8)) { eval q{utf8::upgrade($str)} } +is(Devel::PPPort::UTF8f($str), "[\x{A8}]"); +if (ivers($]) >= ivers(5.8)) { eval q{utf8::downgrade($str)} } +is(Devel::PPPort::UTF8f($str), "[\x{A8}]"); + is(&Devel::PPPort::UTF8_SAFE_SKIP("A", 0), 1); is(&Devel::PPPort::UTF8_SAFE_SKIP("A", -1), 0); @@ -72,27 +83,22 @@ is(&Devel::PPPort::UVCHR_IS_INVARIANT(ord("A")), 1); ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0xb6)); ok(! &Devel::PPPort::UVCHR_IS_INVARIANT(0x100)); -if ("$]" < '5.006') { - skip("Perl version too early", 9); +is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1); +is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test"); +is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5); +is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6); +is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7); +if (ord("A") != 65) { + skip("Test not valid on EBCDIC", 1) } else { - is(&Devel::PPPort::UVCHR_SKIP(ord("A")), 1); - is(&Devel::PPPort::UVCHR_SKIP(0xb6), 2, "This is a test"); - is(&Devel::PPPort::UVCHR_SKIP(0x3FF), 2); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFF), 3); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFFF), 4); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFF), 5); - is(&Devel::PPPort::UVCHR_SKIP(0x3FFFFFF), ord("A") == 65 ? 5 : 6); - is(&Devel::PPPort::UVCHR_SKIP(0x4000000), ord("A") == 65 ? 6 : 7); - if (ord("A") != 65) { - skip("Test not valid on EBCDIC", 1) - } - else { - is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7); - } + is(&Devel::PPPort::UVCHR_SKIP(0xFFFFFFFF), 7); } -if ("$]" < '5.008') { +if (ivers($]) < ivers(5.8)) { skip("Perl version too early", 3); } else { @@ -117,8 +123,53 @@ $ret = &Devel::PPPort::utf8_to_uvchr_buf("\0", 0); is($ret->[0], 0); is($ret->[1], 1); +my @buf_tests = ( + { + input => "A", + adjustment => -1, + warning => eval "qr/empty/", + no_warnings_returned_length => 0, + }, + { + input => "\xc4\xc5", + adjustment => 0, + warning => eval "qr/non-continuation/", + no_warnings_returned_length => 1, + }, + { + input => "\xc4\x80", + adjustment => -1, + warning => eval "qr/short|1 byte, need 2/", + no_warnings_returned_length => 1, + }, + { + input => "\xc0\x81", + adjustment => 0, + warning => eval "qr/overlong|2 bytes, need 1/", + no_warnings_returned_length => 2, + }, + { + input => "\xe0\x80\x81", + adjustment => 0, + warning => eval "qr/overlong|3 bytes, need 1/", + no_warnings_returned_length => 3, + }, + { + input => "\xf0\x80\x80\x81", + adjustment => 0, + warning => eval "qr/overlong|4 bytes, need 1/", + no_warnings_returned_length => 4, + }, + { # Old algorithm failed to detect this + input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf", + adjustment => 0, + warning => eval "qr/overflow/", + no_warnings_returned_length => 13, + }, +); + if (ord("A") != 65) { # tests not valid for EBCDIC - skip("Perl version too early", 1 .. (2 + 4 + (7 * 5))); + skip("Perl version too early", 2 + 4 + (scalar @buf_tests * 5)); } else { $ret = &Devel::PPPort::utf8_to_uvchr_buf("\xc4\x80", 0); @@ -129,71 +180,29 @@ else { local $SIG{__WARN__} = sub { push @warnings, @_; }; { - BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' } + use warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80"); is($ret->[0], 0); is($ret->[1], -1); - BEGIN { 'warnings'->unimport() if "$]" > '5.006' } + no warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr("\xe0\0\x80"); is($ret->[0], 0xFFFD); is($ret->[1], 1); } - my @buf_tests = ( - { - input => "A", - adjustment => -1, - warning => eval "qr/empty/", - no_warnings_returned_length => 0, - }, - { - input => "\xc4\xc5", - adjustment => 0, - warning => eval "qr/non-continuation/", - no_warnings_returned_length => 1, - }, - { - input => "\xc4\x80", - adjustment => -1, - warning => eval "qr/short|1 byte, need 2/", - no_warnings_returned_length => 1, - }, - { - input => "\xc0\x81", - adjustment => 0, - warning => eval "qr/overlong|2 bytes, need 1/", - no_warnings_returned_length => 2, - }, - { - input => "\xe0\x80\x81", - adjustment => 0, - warning => eval "qr/overlong|3 bytes, need 1/", - no_warnings_returned_length => 3, - }, - { - input => "\xf0\x80\x80\x81", - adjustment => 0, - warning => eval "qr/overlong|4 bytes, need 1/", - no_warnings_returned_length => 4, - }, - { # Old algorithm failed to detect this - input => "\xff\x80\x90\x90\x90\xbf\xbf\xbf\xbf\xbf\xbf\xbf\xbf", - adjustment => 0, - warning => eval "qr/overflow/", - no_warnings_returned_length => 13, - }, - ); # An empty input is an assertion failure on debugging builds. It is # deliberately the first test. require Config; import Config; use vars '%Config'; - # VMS doesn't put DEBUGGING in ccflags and Windows doesn't have $Config{config_args}. - # When 5.14 or later can be assumed, use Config::non_bincompat_options(), but for - # now we're stuck with this. - if ($Config{ccflags} =~ /-DDEBUGGING/ - || $^O eq 'VMS' && $Config{config_args} =~ /\bDDEBUGGING\b/) { + + # VMS doesn't put DEBUGGING in ccflags, and Windows doesn't have + # $Config{config_args}. When 5.14 or later can be assumed, use + # Config::non_bincompat_options(), but for now we're stuck with this. + if ( $Config{ccflags} =~ /-DDEBUGGING/ + || $^O eq 'VMS' && $Config{config_args} =~ /\bDDEBUGGING\b/) + { shift @buf_tests; skip("Test not valid on DEBUGGING builds", 5); } @@ -212,7 +221,7 @@ else { my $warning = $test->{'warning'}; undef @warnings; - BEGIN { 'warnings'->import('utf8') if "$]" > '5.006' } + use warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment); is($ret->[0], 0, "returned value $display; warnings enabled"); is($ret->[1], -1, "returned length $display; warnings enabled"); @@ -222,7 +231,7 @@ else { . "; Got: '$all_warnings', which should contain '$warning'"); undef @warnings; - BEGIN { 'warnings'->unimport('utf8') if "$]" > '5.006' } + no warnings 'utf8'; $ret = &Devel::PPPort::utf8_to_uvchr_buf($input, $adjustment); is($ret->[0], 0xFFFD, "returned value $display; warnings disabled"); is($ret->[1], $test->{'no_warnings_returned_length'}, @@ -230,8 +239,8 @@ else { } } -if ("$]" ge '5.008') { - BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } } +if (ivers($]) ge ivers(5.008)) { + BEGIN { if (ivers($]) ge ivers(5.008)) { require utf8; "utf8"->import() } } is(Devel::PPPort::sv_len_utf8("aščť"), 4); is(Devel::PPPort::sv_len_utf8_nomg("aščť"), 4); @@ -266,7 +275,7 @@ if ("$]" ge '5.008') { is(tied($scalar)->{fetch}, 3); is(tied($scalar)->{store}, 0); } else { - skip 'skip: no SV_NOSTEAL support', 23; + skip 'skip: no utf8::downgrade/utf8::upgrade support', 23; } package TieScalarCounter; @@ -277,7 +286,7 @@ sub TIESCALAR { } sub FETCH { - BEGIN { if ("$]" ge '5.008') { require utf8; "utf8"->import() } } + BEGIN { if (main::ivers($]) ge main::ivers(5.008)) { require utf8; "utf8"->import() } } my ($self) = @_; $self->{fetch}++; return $self->{value} .= "é"; |