This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update Devel-PPPort to CPAN version 3.57
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Fri, 7 Feb 2020 10:19:44 +0000 (10:19 +0000)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Fri, 7 Feb 2020 10:19:44 +0000 (10:19 +0000)
  [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)

80 files changed:
MANIFEST
Porting/Maintainers.pl
dist/Devel-PPPort/Changes
dist/Devel-PPPort/Makefile.PL
dist/Devel-PPPort/PPPort_pm.PL
dist/Devel-PPPort/TODO
dist/Devel-PPPort/devel/mkppport_fnc.pl
dist/Devel-PPPort/devel/regenerate
dist/Devel-PPPort/parts/apidoc.fnc
dist/Devel-PPPort/parts/base/5003007
dist/Devel-PPPort/parts/base/5004005
dist/Devel-PPPort/parts/base/5005000
dist/Devel-PPPort/parts/base/5006000
dist/Devel-PPPort/parts/base/5007001
dist/Devel-PPPort/parts/base/5007003
dist/Devel-PPPort/parts/base/5008000
dist/Devel-PPPort/parts/base/5009000
dist/Devel-PPPort/parts/base/5009003
dist/Devel-PPPort/parts/base/5009005
dist/Devel-PPPort/parts/base/5011002
dist/Devel-PPPort/parts/base/5013006
dist/Devel-PPPort/parts/base/5013007
dist/Devel-PPPort/parts/base/5013009
dist/Devel-PPPort/parts/base/5015003
dist/Devel-PPPort/parts/base/5017008
dist/Devel-PPPort/parts/base/5019003
dist/Devel-PPPort/parts/base/5021004
dist/Devel-PPPort/parts/base/5021005
dist/Devel-PPPort/parts/base/5021007
dist/Devel-PPPort/parts/base/5025005
dist/Devel-PPPort/parts/base/5025009
dist/Devel-PPPort/parts/base/5027002
dist/Devel-PPPort/parts/base/5031002
dist/Devel-PPPort/parts/base/5031007
dist/Devel-PPPort/parts/base/5031008 [new file with mode: 0644]
dist/Devel-PPPort/parts/embed.fnc
dist/Devel-PPPort/parts/inc/SvPV
dist/Devel-PPPort/parts/inc/Sv_set
dist/Devel-PPPort/parts/inc/call
dist/Devel-PPPort/parts/inc/format
dist/Devel-PPPort/parts/inc/magic
dist/Devel-PPPort/parts/inc/memory
dist/Devel-PPPort/parts/inc/misc
dist/Devel-PPPort/parts/inc/podtest
dist/Devel-PPPort/parts/inc/ppphbin
dist/Devel-PPPort/parts/inc/utf8
dist/Devel-PPPort/parts/inc/variables
dist/Devel-PPPort/parts/ppport.fnc
dist/Devel-PPPort/parts/todo/5003007
dist/Devel-PPPort/parts/todo/5004005
dist/Devel-PPPort/parts/todo/5006000
dist/Devel-PPPort/parts/todo/5007001
dist/Devel-PPPort/parts/todo/5007002
dist/Devel-PPPort/parts/todo/5007003
dist/Devel-PPPort/parts/todo/5008000
dist/Devel-PPPort/parts/todo/5009000
dist/Devel-PPPort/parts/todo/5009003
dist/Devel-PPPort/parts/todo/5011002
dist/Devel-PPPort/parts/todo/5013006
dist/Devel-PPPort/parts/todo/5013007
dist/Devel-PPPort/parts/todo/5013009
dist/Devel-PPPort/parts/todo/5015003
dist/Devel-PPPort/parts/todo/5019001
dist/Devel-PPPort/parts/todo/5019002
dist/Devel-PPPort/parts/todo/5019003
dist/Devel-PPPort/parts/todo/5021004
dist/Devel-PPPort/parts/todo/5021005
dist/Devel-PPPort/parts/todo/5021007
dist/Devel-PPPort/parts/todo/5025005
dist/Devel-PPPort/parts/todo/5027002
dist/Devel-PPPort/parts/todo/5031007
dist/Devel-PPPort/parts/todo/5031008 [new file with mode: 0644]
dist/Devel-PPPort/t/Sv_set.t
dist/Devel-PPPort/t/call.t
dist/Devel-PPPort/t/format.t
dist/Devel-PPPort/t/magic.t
dist/Devel-PPPort/t/misc.t
dist/Devel-PPPort/t/podtest.t
dist/Devel-PPPort/t/testutil.pl
dist/Devel-PPPort/t/utf8.t

index e28a660..d8d62c6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3219,6 +3219,7 @@ dist/Devel-PPPort/parts/base/5031004      Devel::PPPort baseline todo file
 dist/Devel-PPPort/parts/base/5031005   Devel::PPPort baseline todo file
 dist/Devel-PPPort/parts/base/5031006   Devel::PPPort baseline todo file
 dist/Devel-PPPort/parts/base/5031007   Devel::PPPort baseline todo file
+dist/Devel-PPPort/parts/base/5031008
 dist/Devel-PPPort/parts/embed.fnc      Devel::PPPort Perl API listing
 dist/Devel-PPPort/parts/inc/01_test    Devel::PPPort include
 dist/Devel-PPPort/parts/inc/call       Devel::PPPort include
@@ -3460,6 +3461,7 @@ dist/Devel-PPPort/parts/todo/5031004      Devel::PPPort baseline todo file
 dist/Devel-PPPort/parts/todo/5031005   Devel::PPPort baseline todo file
 dist/Devel-PPPort/parts/todo/5031006   Devel::PPPort baseline todo file
 dist/Devel-PPPort/parts/todo/5031007   Devel::PPPort baseline todo file
+dist/Devel-PPPort/parts/todo/5031008
 dist/Devel-PPPort/PPPort.xs            Devel::PPPort dummy PPPort.xs
 dist/Devel-PPPort/ppport_h.PL          Devel::PPPort ppport.h writer
 dist/Devel-PPPort/PPPort_pm.PL         Devel::PPPort PPPort.pm writer
index e0f976e..d4badfd 100755 (executable)
@@ -339,7 +339,7 @@ use File::Glob qw(:case);
     },
 
     'Devel::PPPort' => {
-        'DISTRIBUTION' => 'ATOOMIC/Devel-PPPort-3.56.tar.gz',
+        'DISTRIBUTION' => 'ATOOMIC/Devel-PPPort-3.57.tar.gz',
         'FILES'        => q[dist/Devel-PPPort],
         'EXCLUDED'     => [
             'PPPort.pm',    # we use PPPort_pm.PL instead
index 5aff2bc..2c7a164 100644 (file)
@@ -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)
index 266e9b1..bc5f502 100644 (file)
@@ -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);
 
index f4f7cf5..f578954 100644 (file)
@@ -711,7 +711,7 @@ package Devel::PPPort;
 use strict;
 use vars qw($VERSION $data);
 
-$VERSION = '3.56';
+$VERSION = '3.57';
 
 sub _init_data
 {
index a54a8c3..2a26d01 100644 (file)
@@ -312,7 +312,6 @@ TODO:
     warn_uninit
     watchaddr
     watchok
-    Xpv
     Yes
 
 * have an --env option for soak to set env variable combinations
index d8b9b00..26adfea 100644 (file)
@@ -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
index 2ce5d12..97b7cbe 100755 (executable)
@@ -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: ",
index ef3dd9e..f455038 100644 (file)
@@ -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
index f3d3468..11fdae8 100644 (file)
@@ -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
index d1fcadd..5abbf16 100644 (file)
@@ -2,6 +2,7 @@
 do_binmode                     # E
 dTHR                           # E
 ERRSV                          # E
+GV_NOINIT                      # E
 newCONSTSUB                    # E
 newSVpvn                       # E
 PL_curcop                      # E
index 19141f8..a9d989f 100644 (file)
@@ -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
index e0274ab..268579a 100644 (file)
@@ -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
index 021df16..14a9a27 100644 (file)
@@ -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
index 1e5ec2d..6360b28 100644 (file)
@@ -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)
index 28ee45d..53b7686 100644 (file)
@@ -1,5 +1,6 @@
 5.008000
 hv_iternext_flags              # U
+HV_ITERNEXT_WANTPLACEHOLDERS   # E
 hv_store_flags                 # U
 nothreadhook                   # U
 Poison                         # E
index 0f681b7..e33d67e 100644 (file)
@@ -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
index 0464dbf..69b81a2 100644 (file)
@@ -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
index f06b4ad..17ce3d5 100644 (file)
@@ -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
index 447639e..651df59 100644 (file)
@@ -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
index 4d4f464..0ee7d59 100644 (file)
@@ -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
index fb14bc9..50f21fa 100644 (file)
@@ -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
index 5a2f5e9..c969c70 100644 (file)
@@ -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
index 5ed19f8..c10cb56 100644 (file)
@@ -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
index 8a67272..1f573e9 100644 (file)
@@ -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
index 6a1a3b8..5bcd299 100644 (file)
@@ -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
index 7bb1735..05a1b65 100644 (file)
@@ -1,4 +1,5 @@
 5.021004
+CALL_CHECKER_REQUIRE_GV        # E
 cv_set_call_checker_flags      # U
 grok_infnan                    # U
 isinfnan                       # U
index bc63e4a..a427083 100644 (file)
@@ -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
index 99b2ac8..4a3d4d0 100644 (file)
@@ -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
index 37064be..7b018ce 100644 (file)
@@ -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
index 6a7c035..71d2ac4 100644 (file)
@@ -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
index 6d60bc5..2ba94f4 100644 (file)
@@ -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
index 6fe7957..7a56370 100644 (file)
@@ -1,2 +1,3 @@
 5.031002
+G_RETHROW                      # E
 Perl_my_mkostemp_cloexec       # F added by devel/scanprov
index e24cbe3..b0206dc 100644 (file)
@@ -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 (file)
index 0000000..7424595
--- /dev/null
@@ -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
index 3a75a4c..4bb864f 100644 (file)
@@ -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
index 592f999..c20cb85 100644 (file)
@@ -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 } )
index e8dfe23..8c3f91b 100644 (file)
@@ -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;
 
index 3daf589..3525854 100644 (file)
@@ -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' };
index 738b703..094076f 100644 (file)
@@ -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;
+}
index 28e161d..3d3b740 100644 (file)
@@ -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;
 
index aa986f5..aa102e2 100644 (file)
@@ -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
index 5705a5f..deb1fb8 100644 (file)
@@ -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)";
index c44c10d..df18c3a 100644 (file)
@@ -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) {
index 3057d12..975e3f6 100644 (file)
@@ -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]*)
   | "[^"\\]*(?:\\.[^"\\]*)*"
index ee30dc5..28f01c0 100644 (file)
@@ -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} .= "é";
index 0165a65..cc984c8 100644 (file)
@@ -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
index 9938c41..4d34f77 100644 (file)
@@ -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
index 7969c27..fc87a0c 100644 (file)
@@ -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
index fe2fc1b..fe3666b 100644 (file)
@@ -1,4 +1,5 @@
 5.004005
 do_binmode                     # U
+GV_NOINIT                      # E
 save_aelem                     # U
 save_helem                     # U
index 0cbe62f..7785939 100644 (file)
@@ -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
index 299ea8d..de1e84e 100644 (file)
@@ -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
index d750787..e763ce3 100644 (file)
@@ -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
index 999b2b5..164ecfd 100644 (file)
@@ -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
index d7942a3..13cc7f2 100644 (file)
@@ -1,5 +1,6 @@
 5.008000
 HeUTF8                         # U
 hv_iternext_flags              # U
+HV_ITERNEXT_WANTPLACEHOLDERS   # E
 hv_store_flags                 # U
 nothreadhook                   # U
index d8e316d..ecbaf1d 100644 (file)
@@ -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
index 5fcebbe..529dc08 100644 (file)
@@ -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
index d81ac64..906e256 100644 (file)
@@ -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
index 589a952..49dbd43 100644 (file)
@@ -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
index 1685d47..8b9162e 100644 (file)
@@ -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
index 0d61e43..45c9725 100644 (file)
@@ -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
index 7f33df7..20e036e 100644 (file)
@@ -1 +1,2 @@
 5.015003
+GV_ADDMG                       # E
index b61335b..06927ae 100644 (file)
@@ -2,4 +2,3 @@
 toFOLD                         # U
 toLOWER_L1                     # U
 toTITLE                        # U
-UTF8f                          # E
index d709ed4..9fcc71e 100644 (file)
@@ -1,3 +1,2 @@
 5.019002
 G_METHOD_NAMED                 # E
-UTF8fARG                       # U
index 4bcc1d1..a6403ca 100644 (file)
@@ -1,2 +1,4 @@
 5.019003
+PERL_EXIT_ABORT                # E
+PERL_EXIT_WARN                 # E
 sv_pos_b2u_flags               # U
index 211c72c..4a209c3 100644 (file)
@@ -1,4 +1,5 @@
 5.021004
+CALL_CHECKER_REQUIRE_GV        # E
 cv_set_call_checker_flags      # U
 grok_infnan                    # U
 isinfnan                       # U
index ddfe99f..2e5af87 100644 (file)
@@ -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
index dfee4f1..485119b 100644 (file)
@@ -9,3 +9,4 @@ PadnamelistREFCNT_dec          # U
 padnamelist_store              # U
 PadnameREFCNT                  # U
 PadnameREFCNT_dec              # U
+PADNAMEt_OUTER                 # E
index bff264b..ab5b700 100644 (file)
@@ -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
index 68515e4..4e50dae 100644 (file)
@@ -1,2 +1,4 @@
 5.027002
 Perl_setlocale                 # U
+UTF8_DISALLOW_PERL_EXTENDED    # E
+UTF8_WARN_PERL_EXTENDED        # E
index d71ccfa..0cd061b 100644 (file)
@@ -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 (file)
index 0000000..f24c040
--- /dev/null
@@ -0,0 +1 @@
+5.031008
index e56e67e..821cf01 100644 (file)
@@ -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;
 
index 8b68428..c26a5a6 100644 (file)
@@ -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' };
index db83868..ef471e0 100644 (file)
@@ -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;
+}
 
index 973f7f6..471c485 100644 (file)
@@ -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;
 
index 3f868c0..6901a19 100644 (file)
@@ -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)";
index 98698ad..73173b4 100644 (file)
@@ -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) {
index 942d254..981b659 100644 (file)
@@ -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;
index 3ba2e8a..12a593e 100644 (file)
@@ -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} .= "é";