#
################################################################################
#
-# $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.
#
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
dTHXa
dTHXoa
dUNDERBAR
+ dXCPT
+ dXSTARG
END_EXTERN_C
ERRSV
eval_pv
UVXf
UVxf
vnewSVpvf
+ XCPT_CATCH
+ XCPT_RETHROW
+ XCPT_TRY_END
+ XCPT_TRY_START
XPUSHmortal
XPUSHu
XSRETURN_UV
SvPVbyte_force
find_rundefsvoffset
+ gv_fetchpvn_flags
+ gv_fetchsv
+ op_refcnt_lock
+ op_refcnt_unlock
+ savesvpv
vnormal
=item perl 5.9.1
=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.
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);
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
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
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
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
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();
};
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|||
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|||
debstackptrs||5.007003|
debstack||5.007003|
deb||5.007003|v
-default_protect|||v
del_he|||
del_sv|||
del_xiv|||
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|||
isSPACE|||
isUPPER|||
is_an_int|||
+is_gv_magical_sv|||
is_gv_magical|||
is_handle_constructor|||
is_lvalue_sub||5.007001|
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
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
savestack_grow|||
+savesvpv||5.009002|
sawparens|||
scalar_mod_type|||
scalarboolean|||
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|||
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|
$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) {
#ifndef dITEMS
# define dITEMS I32 items = SP - MARK
#endif
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
#ifndef dTHR
# define dTHR dNOOP
#endif
#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
#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. */
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)
#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
#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"
# 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
#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 */