Upgrade to Devel::PPPort 3.05.
[p5sagit/p5-mst-13.2.git] / ext / Devel / PPPort / PPPort.pm
index 68a5b06..907cbf5 100644 (file)
@@ -8,13 +8,13 @@
 #
 ################################################################################
 #
-#  $Revision: 30 $
+#  $Revision: 33 $
 #  $Author: mhx $
-#  $Date: 2004/08/17 20:01:49 +0200 $
+#  $Date: 2005/01/31 08:10:55 +0100 $
 #
 ################################################################################
 #
-#  Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
+#  Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
 #  Version 2.x, Copyright (C) 2001, Paul Marquess.
 #  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
 #
@@ -78,7 +78,7 @@ that can check your source code. It will suggest hints and portability
 notes, and can even make suggestions on how to change your code. You
 can run it like any other Perl program:
 
-    perl ppport.h
+    perl ppport.h [options] [files]
 
 It also has embedded documentation, so you can use
 
@@ -143,6 +143,8 @@ in older Perl releases:
     dTHXa
     dTHXoa
     dUNDERBAR
+    dXCPT
+    dXSTARG
     END_EXTERN_C
     ERRSV
     eval_pv
@@ -361,6 +363,10 @@ in older Perl releases:
     UVXf
     UVxf
     vnewSVpvf
+    XCPT_CATCH
+    XCPT_RETHROW
+    XCPT_TRY_END
+    XCPT_TRY_START
     XPUSHmortal
     XPUSHu
     XSRETURN_UV
@@ -382,6 +388,11 @@ Perl below which it is unsupported:
 
   SvPVbyte_force
   find_rundefsvoffset
+  gv_fetchpvn_flags
+  gv_fetchsv
+  op_refcnt_lock
+  op_refcnt_unlock
+  savesvpv
   vnormal
 
 =item perl 5.9.1
@@ -852,7 +863,7 @@ Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
 
 =head1 COPYRIGHT
 
-Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
+Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
 
 Version 2.x, Copyright (C) 2001, Paul Marquess.
 
@@ -873,7 +884,7 @@ require DynaLoader;
 use strict;
 use vars qw($VERSION @ISA $data);
 
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.02 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.05 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
 
 @ISA = qw(DynaLoader);
 
@@ -952,6 +963,7 @@ POD   --nochanges                 don't suggest changes
 POD 
 POD   --list-provided             list provided API
 POD   --list-unsupported          list unsupported API
+POD   --api-info=name             show Perl API portability information
 POD 
 POD =head1 COMPATIBILITY
 POD 
@@ -1032,6 +1044,12 @@ POD Lists the API elements that are known not to be supported by
 POD F<ppport.h> and below which version of Perl they probably
 POD won't be available or work.
 POD 
+POD =head2 --api-info=I<name>
+POD 
+POD Show portability information for API elements matching I<name>.
+POD If I<name> is surrounded by slashes, it is interpreted as a regular
+POD expression.
+POD 
 POD =head1 DESCRIPTION
 POD 
 POD In order for a Perl extension (XS) module to be as portable as possible
@@ -1146,6 +1164,22 @@ POD     perl ppport.h --diff='diff -C 10'
 POD 
 POD This would output context diffs with 10 lines of context.
 POD 
+POD To display portability information for the C<newSVpvn> function,
+POD use:
+POD 
+POD     perl ppport.h --api-info=newSVpvn
+POD 
+POD Since the argument to C<--api-info> can be a regular expression,
+POD you can use
+POD 
+POD     perl ppport.h --api-info=/_nomg$/
+POD 
+POD to display portability information for all C<_nomg> functions or
+POD 
+POD     perl ppport.h --api-info=/./
+POD 
+POD to display information for all known API elements.
+POD 
 POD =head1 BUGS
 POD 
 POD If this version of F<ppport.h> is causing failure during
@@ -1188,7 +1222,7 @@ POD module from CPAN.
 POD 
 POD =head1 COPYRIGHT
 POD 
-POD Version 3.x, Copyright (c) 2004, Marcus Holland-Moritz.
+POD Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
 POD 
 POD Version 2.x, Copyright (C) 2001, Paul Marquess.
 POD 
@@ -1222,7 +1256,7 @@ eval {
   Getopt::Long::GetOptions(\%opt, qw(
     help quiet diag! hints! changes! cplusplus
     patch=s copy=s diff=s compat-version=s
-    list-provided list-unsupported
+    list-provided list-unsupported api-info=s
   )) or usage();
 };
 
@@ -1657,6 +1691,10 @@ UVXf|5.007001||p
 UVof|5.006000||p
 UVuf|5.006000||p
 UVxf|5.006000||p
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002||p
+XCPT_TRY_END|5.009002||p
+XCPT_TRY_START|5.009002||p
 XPUSHi|||
 XPUSHmortal|5.009002||p
 XPUSHn|||
@@ -1787,8 +1825,10 @@ dTHXa|5.006000||p
 dTHXoa|5.006000||p
 dTHX|5.006000||p
 dUNDERBAR|5.009002||p
+dXCPT|5.009002||p
 dXSARGS|||
 dXSI32|||
+dXSTARG|5.006000||p
 deb_curcv|||
 deb_nocontext|||vn
 deb_stack_all|||
@@ -1799,7 +1839,6 @@ debprof|||
 debstackptrs||5.007003|
 debstack||5.007003|
 deb||5.007003|v
-default_protect|||v
 del_he|||
 del_sv|||
 del_xiv|||
@@ -1978,7 +2017,9 @@ gv_fetchmeth_autoload||5.007003|
 gv_fetchmethod_autoload||5.004000|
 gv_fetchmethod|||
 gv_fetchmeth|||
+gv_fetchpvn_flags||5.009002|
 gv_fetchpv|||
+gv_fetchsv||5.009002|
 gv_fullname3||5.004000|
 gv_fullname4||5.006001|
 gv_fullname|||
@@ -2054,6 +2095,7 @@ isLOWER|||
 isSPACE|||
 isUPPER|||
 is_an_int|||
+is_gv_magical_sv|||
 is_gv_magical|||
 is_handle_constructor|||
 is_lvalue_sub||5.007001|
@@ -2376,6 +2418,8 @@ op_const_sv|||
 op_dump||5.006000|
 op_free|||
 op_null||5.007002|
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
 open_script|||
 pMY_CXT_|5.007003||p
 pMY_CXT|5.007003||p
@@ -2553,6 +2597,7 @@ savepv|||
 savesharedpv||5.007003|
 savestack_grow_cnt||5.008001|
 savestack_grow|||
+savesvpv||5.009002|
 sawparens|||
 scalar_mod_type|||
 scalarboolean|||
@@ -2818,14 +2863,10 @@ uvchr_to_utf8||5.007001|
 uvuni_to_utf8_flags||5.007003|
 uvuni_to_utf8||5.007001|
 validate_suid|||
-vcall_body|||
-vcall_list_body|||
 vcmp||5.009000|
 vcroak||5.006000|
 vdeb||5.007003|
-vdefault_protect|||
 vdie|||
-vdocatch_body|||
 vform||5.006000|
 visit|||
 vivify_defelem|||
@@ -2835,8 +2876,6 @@ vmess||5.006000|
 vnewSVpvf|5.006000|5.004000|p
 vnormal||5.009002|
 vnumify||5.009000|
-vparse_body|||
-vrun_body|||
 vstringify||5.009000|
 vwarner||5.006000|
 vwarn||5.006000|
@@ -2893,6 +2932,41 @@ while (<DATA>) {
   $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
 }
 
+if (exists $opt{'api-info'}) {
+  my $f;
+  my $count = 0;
+  my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
+  for $f (sort { lc $a cmp lc $b } keys %API) {
+    next unless $f =~ /$match/;
+    print "\n=== $f ===\n\n";
+    my $info = 0;
+    if ($API{$f}{base} || $API{$f}{todo}) {
+      my $base = format_version($API{$f}{base} || $API{$f}{todo});
+      print "Supported at least starting from perl-$base.\n";
+      $info++;
+    }
+    if ($API{$f}{provided}) {
+      my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
+      print "Support by $ppport provided back to perl-$todo.\n";
+      print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
+      print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
+      print "$hints{$f}" if exists $hints{$f};
+      $info++;
+    }
+    unless ($info) {
+      print "No portability information available.\n";
+    }
+    $count++;
+  }
+  if ($count > 0) {
+    print "\n";
+  }
+  else {
+    print "Found no API matching '$opt{'api-info'}'.\n";
+  }
+  exit 0;
+}
+
 if (exists $opt{'list-provided'}) {
   my $f;
   for $f (sort { lc $a cmp lc $b } keys %API) {
@@ -4073,6 +4147,9 @@ typedef NVTYPE NV;
 #ifndef dITEMS
 #  define dITEMS                         I32 items = SP - MARK
 #endif
+#ifndef dXSTARG
+#  define dXSTARG                        SV * targ = sv_newmortal()
+#endif
 #ifndef dTHR
 #  define dTHR                           dNOOP
 #endif
@@ -4290,8 +4367,6 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
 #endif
 #endif
 
-#ifndef START_MY_CXT
-
 /*
  * Boilerplate macros for initializing and accessing interpreter-local
  * data from C.  All statics in extensions should be reworked to use
@@ -4314,6 +4389,8 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
     defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
 
+#ifndef START_MY_CXT
+
 /* This must appear in all extensions that define a my_cxt_t structure,
  * right after the definition (i.e. at file scope).  The non-threads
  * case below uses it to declare the data as static. */
@@ -4345,13 +4422,6 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
        Zero(my_cxtp, 1, my_cxt_t);                                     \
        sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
 
-/* Clones the per-interpreter data. */
-#define MY_CXT_CLONE \
-       dMY_CXT_SV;                                                     \
-       my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
-       Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
-       sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-
 /* This macro must be used to access members of the my_cxt_t structure.
  * e.g. MYCXT.some_data */
 #define MY_CXT         (*my_cxtp)
@@ -4365,13 +4435,25 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
 #define aMY_CXT_       aMY_CXT,
 #define _aMY_CXT       ,aMY_CXT
 
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+       dMY_CXT_SV;                                                     \
+       my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+       Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+       sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
 #else /* single interpreter */
 
+#ifndef START_MY_CXT
+
 #define START_MY_CXT   static my_cxt_t my_cxt;
 #define dMY_CXT_SV     dNOOP
 #define dMY_CXT                dNOOP
 #define MY_CXT_INIT    NOOP
-#define MY_CXT_CLONE   NOOP
 #define MY_CXT         my_cxt
 
 #define pMY_CXT                void
@@ -4381,10 +4463,14 @@ DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
 #define aMY_CXT_
 #define _aMY_CXT
 
-#endif 
-
 #endif /* START_MY_CXT */
 
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE   NOOP
+#endif
+
+#endif
+
 #ifndef IVdf
 #  if IVSIZE == LONGSIZE
 #    define    IVdf      "ld"
@@ -4518,7 +4604,7 @@ DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
 #  define sv_pvn(sv, len)                SvPV(sv, len)
 #endif
 
-/* Hint: sv_pvn
+/* Hint: sv_pvn_force
  * Always use the SvPV_force() macro instead of sv_pvn_force().
  */
 #ifndef sv_pvn_force
@@ -5706,6 +5792,26 @@ DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
 #endif
 #endif
 
+#ifdef dJMPENV
+
+#  ifndef dXCPT
+#    define dXCPT             dJMPENV; int rEtV = 0
+#    define XCPT_TRY_START    JMPENV_PUSH(rEtV); if (rEtV == 0)
+#    define XCPT_TRY_END      JMPENV_POP;
+#    define XCPT_CATCH        if (rEtV != 0)
+#    define XCPT_RETHROW      JMPENV_JUMP(rEtV)
+#  endif
+
+#else
+
+#  define dXCPT             Sigjmp_buf oldTOP; int rEtV = 0
+#  define XCPT_TRY_START    Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
+#  define XCPT_TRY_END      Copy(oldTOP, top_env, 1, Sigjmp_buf);
+#  define XCPT_CATCH        if (rEtV != 0)
+#  define XCPT_RETHROW      Siglongjmp(top_env, rEtV)
+
+#endif
+
 #endif /* _P_P_PORTABILITY_H_ */
 
 /* End of File ppport.h */