This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
concise-xs.t is overly chummy with B::Deparse
[perl5.git] / ext / B / t / concise-xs.t
index ba9a1ed..2f1737a 100644 (file)
@@ -20,7 +20,7 @@ and the stash is scanned for the function-names in that package.
 Each value in %$testpkgs is a hash-of-lists (HoL) whose keys are
 implementation-types and values are lists of function-names of that type.
 
-To keep these HoLs smaller and more managable, they may carry an
+To keep these HoLs smaller and more manageable, they may carry an
 additional 'dflt' => $impl_Type, which means that unnamed functions
 are expected to be of that default implementation type.  Those unnamed
 functions are known from the scan of the package stash.
@@ -38,7 +38,7 @@ If a function is implemented differently on different platforms, the
 test for that function will fail on one of those platforms.  These
 specific functions can be skipped by a 'skip' => [ @list ] to the HoL
 mentioned previously.  See usage for skip in B's HoL, which avoids
-testing a function which doesnt exist on non-threaded builds.
+testing a function which doesn't exist on non-threaded builds.
 
 =head1 OPTIONS AND ARGUMENTS
 
@@ -95,13 +95,7 @@ Looking at ../foo2, you'll see 34 occurrences of the following error:
 =cut
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       chdir('t') if -d 't';
-       @INC = ('.', '../lib');
-    } else {
-       unshift @INC, 't';
-       push @INC, "../../t";
-    }
+    unshift @INC, 't';
     require Config;
     if (($Config::Config{'extensions'} !~ /\bB\b/) ){
         print "1..0 # Skip -- Perl configured without B module\n";
@@ -115,13 +109,7 @@ BEGIN {
 
 use Getopt::Std;
 use Carp;
-use Test::More tests => ( # per-pkg tests (function ct + require_ok)
-                         40 + 16       # Data::Dumper, Digest::MD5
-                         + 517 + 239   # B::Deparse, B
-                         + 595 + 190   # POSIX, IO::Socket
-                         + 345 * ($] > 5.009)
-                         + 17 * ($] >= 5.009003)
-                         - 365);       # fudge
+use Test::More 'no_plan';
 
 require_ok("B::Concise");
 
@@ -139,10 +127,13 @@ my $testpkgs = {
     Digest::MD5 => { perl => [qw/ import /],
                     dflt => 'XS' },
 
-    Data::Dumper => { XS => [qw/ bootstrap Dumpxs /],
+    Data::Dumper => { XS => [qw/ bootstrap Dumpxs /,
+                       $] >= 5.015 ? qw/_vstring / : () ],
+                   $] >= 5.015
+                       ?  (constant => ['_bad_vsmg']) : (),
                      dflt => 'perl' },
     B => { 
-       dflt => 'constant',             # all but 47/274
+       dflt => 'constant',             # all but 47/297
        skip => [ 'regex_padav' ],      # threaded only
        perl => [qw(
                    walksymtable walkoptree_slow walkoptree_exec
@@ -157,34 +148,69 @@ my $testpkgs = {
                  formfeed end_av dowarn diehook defstash curstash
                  cstring comppadlist check_av cchar cast_I32 bootstrap
                  begin_av amagic_generation sub_generation address
-                 ), $] > 5.009 ? ('unitcheck_av') : ()],
+                 unitcheck_av) ],
     },
 
-    B::Deparse => { dflt => 'perl',    # 235 functions
+    B::Deparse => { dflt => 'perl',    # 236 functions
 
        XS => [qw( svref_2object perlstring opnumber main_start
                   main_root main_cv )],
 
-       constant => [qw/ ASSIGN CVf_ASSERTION CVf_LOCKED CVf_LVALUE
+       constant => [qw/ ASSIGN CVf_LVALUE
                     CVf_METHOD LIST_CONTEXT OP_CONST OP_LIST OP_RV2SV
                     OP_STRINGIFY OPf_KIDS OPf_MOD OPf_REF OPf_SPECIAL
                     OPf_STACKED OPf_WANT OPf_WANT_LIST OPf_WANT_SCALAR
-                    OPf_WANT_VOID OPpCONST_ARYBASE OPpCONST_BARE
+                    OPf_WANT_VOID OPpCONST_BARE OPpCONST_NOVER
                     OPpENTERSUB_AMPER OPpEXISTS_SUB OPpITER_REVERSED
                     OPpLVAL_INTRO OPpOUR_INTRO OPpSLICE OPpSORT_DESCEND
                     OPpSORT_INPLACE OPpSORT_INTEGER OPpSORT_NUMERIC
-                    OPpSORT_REVERSE OPpTARGET_MY OPpTRANS_COMPLEMENT
-                    OPpTRANS_DELETE OPpTRANS_SQUASH PMf_CONTINUE
-                    PMf_EVAL PMf_EXTENDED PMf_FOLD PMf_GLOBAL PMf_KEEP
-                    PMf_MULTILINE PMf_ONCE PMf_SINGLELINE PMf_SKIPWHITE
+                    OPpSORT_REVERSE OPpREVERSE_INPLACE OPpTARGET_MY
+                    OPpTRANS_COMPLEMENT OPpTRANS_DELETE OPpTRANS_SQUASH
+                    PMf_CONTINUE PMf_EVAL PMf_EXTENDED PMf_FOLD PMf_GLOBAL
+                    PMf_KEEP PMf_NONDESTRUCT
+                    PMf_MULTILINE PMf_ONCE PMf_SINGLELINE
                     POSTFIX SVf_FAKE SVf_IOK SVf_NOK SVf_POK SVf_ROK
                     SVpad_OUR SVs_RMG SVs_SMG SWAP_CHILDREN OPpPAD_STATE
-                    /],
+                    OPpCONST_ARYBASE RXf_SKIPWHITE SVpad_TYPED/,
+                    $] >= 5.015 ? qw(
+                    OP_GLOB PMf_SKIPWHITE RXf_PMf_CHARSET RXf_PMf_KEEPCOPY
+                    OPpEVAL_BYTES OPpSUBSTR_REPL_FIRST) : (),
+                    $] >= 5.019 ? qw(OP_PUSHMARK OP_NULL) : (),
+                   'CVf_LOCKED', # This ends up as a constant, pre or post 5.10
+                   ],
                 },
 
     POSIX => { dflt => 'constant',                     # all but 252/589
-              skip => [qw/ _POSIX_JOB_CONTROL /],      # platform varying
-              perl => [qw/ import croak AUTOLOAD /],
+              skip => [qw/ _POSIX_JOB_CONTROL /,       # platform varying
+                       # Might be XS or imported from Fcntl, depending on your
+                       # perl version:
+                       qw / S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISREG /,
+                       # Might be XS or AUTOLOADed, depending on your perl
+                       # version:
+                       qw /WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED
+                           WSTOPSIG WTERMSIG/,
+                      'int_macro_int', # Removed in POSIX 1.16
+
+                       'strtold', # platform varying (C99)
+
+                        qw/fegetround fesetround/,
+
+                        # C99 math
+                        qw/acosh asinh atanh cbrt copysign cosh erf
+                        erfc exp2 expm1 fdim fma fmax fmin fpclassify
+                        hypot ilogb isfinite isgreater isgreaterequal
+                        isinf isless islessequal islessgreater isnan
+                        isnormal isunordered j0 j1 jn lgamma log1p
+                        log2 logb lrint lround nan nearbyint nextafter
+                        nexttoward remainder remquo rint round scalbn
+                        signbit sinh tanh tgamma trunc y0 y1 yn/,
+
+                      ],
+              perl => [qw/ import croak AUTOLOAD /,
+                       $] >= 5.015
+                           ? qw/load_imports usage printf sprintf perror/
+                           : (),
+                       ],
 
               XS => [qw/ write wctomb wcstombs uname tzset tzname
                      ttyname tmpnam times tcsetpgrp tcsendbreak
@@ -197,12 +223,12 @@ my $testpkgs = {
                      mblen lseek log10 localeconv ldexp lchown
                      isxdigit isupper isspace ispunct isprint
                      islower isgraph isdigit iscntrl isalpha
-                     isalnum int_macro_int getcwd frexp fpathconf
+                     isalnum getcwd frexp fpathconf
                      fmod floor dup2 dup difftime cuserid ctime
                      ctermid cosh constant close clock ceil
                      bootstrap atan asin asctime acos access abort
                      _exit
-                     /],
+                     /, $] >= 5.015 ? ('sleep') : () ],
               },
 
     IO::Socket => { dflt => 'constant',                # 157/190
@@ -213,13 +239,15 @@ my $testpkgs = {
                             register_domain recv protocol peername
                             new listen import getsockopt croak
                             connected connect configure confess close
-                            carp bind atmark accept
-                            /, $] > 5.009 ? ('blocking') : () ],
+                            carp bind atmark accept sockaddr_in6
+                            blocking/ ],
 
                    XS => [qw/ unpack_sockaddr_un unpack_sockaddr_in
                           sockatmark sockaddr_family pack_sockaddr_un
                           pack_sockaddr_in inet_ntoa inet_aton
+                          unpack_sockaddr_in6 pack_sockaddr_in6
                           /],
+            # skip inet_ntop and inet_pton as they're not exported by default
                },
 };
 
@@ -245,6 +273,7 @@ EODIE
 if (%opts) {
     require Data::Dumper;
     Data::Dumper->import('Dumper');
+    { my $x = \*Data::Dumper::Sortkeys } # shut up 'used once' warning
     $Data::Dumper::Sortkeys = 1;
 }
 my @argpkgs = @ARGV;
@@ -347,6 +376,7 @@ sub corecheck {
        warn "Module::CoreList not available on $]\n";
        return;
     }
+    { my $x = \*Module::CoreList::version } # shut up 'used once' warning
     my $mods = $Module::CoreList::version{'5.009002'};
     $mods = [ sort keys %$mods ];
     print Dumper($mods);
@@ -358,6 +388,7 @@ sub corecheck {
 
 END {
     if ($opts{c}) {
+       { my $x = \*Data::Dumper::Indent } # shut up 'used once' warning
        $Data::Dumper::Indent = 1;
        print "Corrections: ", Dumper(\%report);