New Upstream Release - libdevel-callchecker-perl
Ready changes
Summary
Merged new upstream version: 0.009 (was: 0.008).
Resulting package
Built on 2023-05-02T00:22 (took 10m4s)
The resulting binary packages can be installed (if you have the apt repository enabled) by running one of:
apt install -t fresh-releases libdevel-callchecker-perl-dbgsymapt install -t fresh-releases libdevel-callchecker-perl
Lintian Result
Diff
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..8f0b38b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,29 @@
+/Build
+/Makefile
+/_build
+/blib
+/META.json
+/META.yml
+/MYMETA.json
+/MYMETA.yml
+/Makefile.PL
+/SIGNATURE
+/Devel-CallChecker-*
+/lib/Devel/CallChecker.c
+/lib/Devel/CallChecker.o
+/t/callck_callchecker0.h
+/t/callck.c
+/t/callck.o
+/t/callck.so
+/t/rv2cvopcv_callchecker0.h
+/t/rv2cvopcv.c
+/t/rv2cvopcv.o
+/t/rv2cvopcv.so
+/t/threads1_callchecker0.h
+/t/threads1.c
+/t/threads1.o
+/t/threads1.so
+/t/threads2_callchecker0.h
+/t/threads2.c
+/t/threads2.o
+/t/threads2.so
diff --git a/Changes b/Changes
index ef9444f..302ddbb 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,45 @@
+version 0.009; 2023-04-10
+
+ * port to Perl 5.33.1, which defines a PERL_VERSION_GE() macro that
+ clashes with the one this module previously had
+
+ * skip thread tests on some old versions of Perl (around 5.10.0) where
+ a core bug makes thread creation violate an internal assertion and
+ causes crashes
+
+ * skip thread tests on pre-5.8.9 Perls where a core bug makes thread
+ creation corrupt memory
+
+ * skip thread tests on pre-5.8.3 Perls where a core bug makes thread
+ completion break the global PL_sv_placeholder
+
+ * put whitespace around C string literals being pasted, for C++11
+ compatibility
+
+ * avoid using C preprocessor directives inside a macro argument list
+ (which is not valid)
+
+ * in XS code in the test suite, when croaking, avoid using __FILE__
+ as part of a format string, in case it includes a metacharacter
+
+ * document the intended scope of this module's backporting effort
+
+ * fix a documentation wording glitch
+
+ * in XS declare as const some data that never changes
+
+ * refactor thread tests
+
+ * in XS, refactor Perl version comparisons
+
+ * in XS, rename some macros for better style
+
+ * in XS, better argument parenthesisation in some macros
+
+ * avoid some compiler warnings
+
+ * in .gitignore, list temporary files produced by test XS compilation
+
version 0.008; 2017-07-26
* update test suite to not rely on . in @INC, which is no longer
diff --git a/META.json b/META.json
index f57465d..2266854 100644
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
"Andrew Main (Zefram) <zefram@fysh.org>"
],
"dynamic_config" : 0,
- "generated_by" : "Module::Build version 0.4224",
+ "generated_by" : "Module::Build version 0.4232",
"license" : [
"perl_5"
],
@@ -54,7 +54,7 @@
"provides" : {
"Devel::CallChecker" : {
"file" : "lib/Devel/CallChecker.pm",
- "version" : "0.008"
+ "version" : "0.009"
}
},
"release_status" : "stable",
@@ -67,6 +67,6 @@
"http://dev.perl.org/licenses/"
]
},
- "version" : "0.008",
+ "version" : "0.009",
"x_serialization_backend" : "JSON::PP version 2.93"
}
diff --git a/META.yml b/META.yml
index 1152ec9..e6bd04a 100644
--- a/META.yml
+++ b/META.yml
@@ -21,7 +21,7 @@ configure_requires:
conflicts:
B::Hooks::OP::Check: '< 0.19'
dynamic_config: 0
-generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010'
+generated_by: 'Module::Build version 0.4232, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -30,7 +30,7 @@ name: Devel-CallChecker
provides:
Devel::CallChecker:
file: lib/Devel/CallChecker.pm
- version: '0.008'
+ version: '0.009'
requires:
DynaLoader: '0'
DynaLoader::Functions: '0.001'
@@ -42,5 +42,5 @@ requires:
resources:
bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Devel-CallChecker
license: http://dev.perl.org/licenses/
-version: '0.008'
+version: '0.009'
x_serialization_backend: 'CPAN::Meta::YAML version 0.012'
diff --git a/README b/README
index 733cab1..5390302 100644
--- a/README
+++ b/README
@@ -15,8 +15,23 @@ from XS code on much earlier Perl versions, but it is painful to achieve
without the centralised facility.)
This module provides the implementation of the functions at runtime
-(on Perls where they are not provided by the core), and also at compile
-time supplies the C header file which provides access to the functions.
+(on Perls where they are not provided by the core). It also, at compile
+time, supplies the C header file and link library which provide access to
+the functions. In normal use, callchecker0_h and callchecker_linkable
+should be called at build time (not authoring time) for the module that
+wishes to use the C functions.
+
+The purpose of this module is specifically to provide the Perl 5.14.0
+version of the "cv_set_call_checker" API to earlier Perl versions where
+the core doesn't have "cv_set_call_checker" at all. This module does not
+attempt to backport later refinements of the "cv_set_call_checker" API.
+Thus an XS module that uses this module can be sure of having at least
+the Perl 5.14.0 version of "cv_set_call_checker" available, regardless
+of which Perl version it is running on, but cannot be sure of having
+any more refined version of the API available. Such a module will have
+access to the core's version of the API as normal on Perl versions where
+the core supplies it, and is free to use the ordinary mechanisms of Perl
+version portability to manage the differences between versions of the API.
INSTALLATION
@@ -31,7 +46,7 @@ Andrew Main (Zefram) <zefram@fysh.org>
COPYRIGHT
-Copyright (C) 2011, 2012, 2013, 2015, 2017
+Copyright (C) 2011, 2012, 2013, 2015, 2017, 2023
Andrew Main (Zefram) <zefram@fysh.org>
LICENSE
diff --git a/SIGNATURE b/SIGNATURE
index e823b67..cdd94b5 100644
--- a/SIGNATURE
+++ b/SIGNATURE
@@ -1,5 +1,5 @@
This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.81.
+signed via the Module::Signature module, version 0.88.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -12,33 +12,32 @@ the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
-----BEGIN PGP SIGNED MESSAGE-----
-Hash: SHA1
+Hash: RIPEMD160
-SHA1 28471ed9c62bbfb12a2afac9911c6dd919b7f9f5 .gitignore
-SHA1 f34e5db24a9ababe49ae281e723f98675a0169ad Build.PL
-SHA1 2a03825714cc27cfead4445266f6eca9ab570f14 Changes
-SHA1 ed757788d1aec2d2c3a87f40dd5ad4585def7816 MANIFEST
-SHA1 b36885f12a506254a0749826ca2b6e854e3116cf META.json
-SHA1 a89628c6a82fdf7aee67196e4d3ddfffd5d8ba0e META.yml
-SHA1 e5143ca74f252449f51ae1f5971cc92cfb80f794 README
-SHA1 df9ab5f6152be6ce3790805957d44039b5eea363 lib/Devel/CallChecker.pm
-SHA1 df333dd9a5563f8f0afa0cd8d60a6caa56bc76bd lib/Devel/CallChecker.xs
-SHA1 7bbcdddd858a25a26167ee5f7ff642efbcf1b646 t/callck.t
-SHA1 19955e7370031cec5f5787f26d9632ac9fe52c3b t/callck.xs
-SHA1 f02cae7124e7060dbd03f4b62113532e08b289d9 t/lib/t/LoadXS.pm
-SHA1 3652419516be8528af3d5e7cb45d06f7ccbb7237 t/lib/t/WriteHeader.pm
-SHA1 904d9a4f76525e2303e4b0c168c68230f223c8de t/pod_cvg.t
-SHA1 65c75abdef6f01a5d1588a307f2ddfe2333dc961 t/pod_syn.t
-SHA1 5592ca771efd6617e525dd115c575ba2106ba14d t/rv2cvopcv.t
-SHA1 c8ddecbc62112ef846d14ebdaf91b50156d80ed5 t/rv2cvopcv.xs
-SHA1 102817fd6fa671998951fdf1dc56333bdf56532c t/threads.t
-SHA1 1ad7681a845fdecc219ce5b0ced752ec084beb1d t/threads1.xs
-SHA1 30e0563165e2583c63ec573887503a8ce8e5a643 t/threads2.xs
-SHA1 80af1f40b1054da5c48fe7b3d22f1796cd24d3d8 typemap
+SHA256 93b7de35e3b9e01825354d186737790db4426434b89d67b9b5d4bc416cebf13c .gitignore
+SHA256 793a6920cfd3a554077dbe33d6e19f75e7eb02c1664f2533cd745fb500c757e0 Build.PL
+SHA256 7653e00a89460baa8b794c18786f472efb658d3836e7e403dd457512b14361ed Changes
+SHA256 7c3461cd24be7bf774a9b8f41b35ef4d4cfdf36b9c81b948ec59c7696be2b294 MANIFEST
+SHA256 e92aeb67143f8f19b996339fbd564880b8fd3005904aee2e674aaccf325d6201 META.json
+SHA256 34731ba8d0a5e567300b06a11464c228d9ee85f2d3e00e3e3c6e0cea0cdced27 META.yml
+SHA256 17fb06e3c2d6f62dbfada360f19834cb31453a3fdda5a566955b0882597b5cb0 README
+SHA256 2a36b7fb95c5e7386d2af3957071305eca00655fd7300629f04f0cba53314afb lib/Devel/CallChecker.pm
+SHA256 53a0f1f0e3b5c9cdacf3f9285da63c7731a269d0cdca768ee5290995a3c0259a lib/Devel/CallChecker.xs
+SHA256 b164d049c4c4f717270c59c5b46645990acde922e995b5f575d10831b9cc738f t/callck.t
+SHA256 cc4d18d8c070d7545aa078792fab45bd43dfd32ec74ffe11c9f16ae5229dce64 t/callck.xs
+SHA256 47a6b7a7b9201a6d33a8d11310b80ac13e9be60c5e809899e7232b7e05217860 t/lib/t/LoadXS.pm
+SHA256 459c6f1151a22bfcbc921c248196995028e4a4282884c19471edbe6d80c26397 t/lib/t/WriteHeader.pm
+SHA256 3679257bdfb4a07658e98a41325f82c1744f7dae6d1d0151f1b216af0c1df5c9 t/pod_cvg.t
+SHA256 e16860066c4ca9b2ee9e7d4604297def8a58b53bf0ca03eed863b5d9c5a2ac91 t/pod_syn.t
+SHA256 7df417659f64a5286437d0968a0a51f95fefe38fbeb857eed0a7dd6db7dd6137 t/rv2cvopcv.t
+SHA256 a188c6122309825246990a856dee98478d640270338675c2b0d0aadef137a55b t/rv2cvopcv.xs
+SHA256 e677e276eb8d17ebb5d4aff66808e38fcaeaeff23c369a7404d624684e98d3d5 t/threads.t
+SHA256 1ae17126136a115d97b7587de72588b998bde50b1632ffb949e02e574217e115 t/threads1.xs
+SHA256 59f9347a5cb3e9ab86a35fc9bc60a394b55b0f3414f5f615dee870f6041f3d1a t/threads2.xs
+SHA256 7c78b44035627c9b84b6c8e065aed9c3389865a58698d97a3b8324d576d47df5 typemap
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1
-iEYEARECAAYFAll4OqkACgkQOV9mt2VyAVFDDQCgpuEcBg81kbhbf+eho952VNNr
-nBgAn0PVrAvAjMGbYGQ3SuD2wjlktxGf
-=u2BU
+iEYEAREDAAYFAmQ0Ly8ACgkQOV9mt2VyAVET5ACfdjEjeFljQRXcBpSPMk3bd+vF
+xRwAn2g2KEXdy5UlgTawF6hjk+8/8cqT
+=lX94
-----END PGP SIGNATURE-----
diff --git a/debian/changelog b/debian/changelog
index 34e3bbe..5bcf84d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+libdevel-callchecker-perl (0.009-1) UNRELEASED; urgency=low
+
+ * New upstream release.
+
+ -- Debian Janitor <janitor@jelmer.uk> Tue, 02 May 2023 00:13:15 -0000
+
libdevel-callchecker-perl (0.008-2) unstable; urgency=medium
[ Debian Janitor ]
diff --git a/lib/Devel/CallChecker.pm b/lib/Devel/CallChecker.pm
index 0d416dd..5901c08 100644
--- a/lib/Devel/CallChecker.pm
+++ b/lib/Devel/CallChecker.pm
@@ -40,6 +40,17 @@ functions. In normal use, L</callchecker0_h> and L</callchecker_linkable>
should be called at build time (not authoring time) for the module that
wishes to use the C functions.
+The purpose of this module is specifically to provide the Perl 5.14.0
+version of the C<cv_set_call_checker> API to earlier Perl versions where
+the core doesn't have C<cv_set_call_checker> at all. This module does not
+attempt to backport later refinements of the C<cv_set_call_checker> API.
+Thus an XS module that uses this module can be sure of having at least
+the Perl 5.14.0 version of C<cv_set_call_checker> available, regardless
+of which Perl version it is running on, but cannot be sure of having
+any more refined version of the API available. Such a module will have
+access to the core's version of the API as normal on Perl versions where
+the core supplies it, and is free to use the ordinary mechanisms of Perl
+version portability to manage the differences between versions of the API.
=cut
@@ -49,7 +60,7 @@ package Devel::CallChecker;
use warnings;
use strict;
-our $VERSION = "0.008";
+our $VERSION = "0.009";
use parent "Exporter";
our @EXPORT_OK = qw(callchecker0_h callchecker_linkable);
@@ -113,7 +124,7 @@ apply a prototype to a subroutine call. From version 5.11.2 onwards, the
subroutine can be determined if the RV that the C<rv2cv> is to operate
on is provided by a suitable C<gv> or C<const> op. Prior to 5.11.2,
only a C<gv> op will do. A C<gv> op is suitable if the GV's CV slot
-is populated. A C<const> op is suitable if the constant value must be
+is populated. A C<const> op is suitable if the constant value is
an RV pointing to a CV. Details of this process may change in future
versions of Perl.
@@ -273,7 +284,7 @@ Andrew Main (Zefram) <zefram@fysh.org>
=head1 COPYRIGHT
-Copyright (C) 2011, 2012, 2013, 2015, 2017
+Copyright (C) 2011, 2012, 2013, 2015, 2017, 2023
Andrew Main (Zefram) <zefram@fysh.org>
=head1 LICENSE
diff --git a/lib/Devel/CallChecker.xs b/lib/Devel/CallChecker.xs
index 993c5d5..c9a1823 100644
--- a/lib/Devel/CallChecker.xs
+++ b/lib/Devel/CallChecker.xs
@@ -3,18 +3,33 @@
#include "perl.h"
#include "XSUB.h"
-#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_DECIMAL(r,v,s) ((r)*1000000 + (v)*1000 + (s))
+#define Q_PERL_DECIMAL_VERSION \
+ Q_PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define Q_PERL_VERSION_GE(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION >= Q_PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_LT(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION < Q_PERL_VERSION_DECIMAL(r,v,s))
+
+#if (Q_PERL_VERSION_GE(5,17,6) && Q_PERL_VERSION_LT(5,17,11)) || \
+ (Q_PERL_VERSION_GE(5,19,3) && Q_PERL_VERSION_LT(5,21,1))
+PERL_STATIC_INLINE void suppress_unused_warning(void)
+{
+ (void) S_croak_memory_wrap;
+}
+#endif /* (>=5.17.6 && <5.17.11) || (>=5.19.3 && <5.21.1) */
+
+#if Q_PERL_VERSION_LT(5,7,2)
+# undef dNOOP
+# define dNOOP extern int Perl___notused_func(void)
+#endif /* <5.7.2 */
#ifndef cBOOL
# define cBOOL(x) ((bool)!!(x))
#endif /* !cBOOL */
#ifndef newSVpvs
-# define newSVpvs(s) newSVpvn(""s"", (sizeof(""s"")-1))
+# define newSVpvs(s) newSVpvn("" s "", (sizeof("" s "")-1))
#endif /* !newSVpvs */
#ifndef OpMORESIB_set
@@ -27,36 +42,44 @@
# define OpSIBLING(o) (0 + (o)->op_sibling)
#endif /* !OpSIBLING */
-#define QPFX xAd8NP3gxZglovQRL5Hn_
-#define QPFXS STRINGIFY(QPFX)
-#define QCONCAT0(a,b) a##b
-#define QCONCAT1(a,b) QCONCAT0(a,b)
-#define QPFXD(name) QCONCAT1(QPFX, name)
-
-#if defined(WIN32) && PERL_VERSION_GE(5,13,6)
-# define MY_BASE_CALLCONV EXTERN_C
-# define MY_BASE_CALLCONV_S "EXTERN_C"
+#if Q_PERL_VERSION_GE(5,7,3)
+# define PERL_UNUSED_THX() NOOP
+#else /* <5.7.3 */
+# define PERL_UNUSED_THX() ((void)(aTHX+0))
+#endif /* <5.7.3 */
+
+#define Q_PFX xAd8NP3gxZglovQRL5Hn_
+#define Q_PFXS STRINGIFY(Q_PFX)
+#define Q_CONCAT0(a,b) a##b
+#define Q_CONCAT1(a,b) Q_CONCAT0(a,b)
+#define Q_PFXD(name) Q_CONCAT1(Q_PFX, name)
+
+#if defined(WIN32) && Q_PERL_VERSION_GE(5,13,6)
+# define Q_BASE_CALLCONV EXTERN_C
+# define Q_BASE_CALLCONV_S "EXTERN_C"
#else /* !(WIN32 && >= 5.13.6) */
-# define MY_BASE_CALLCONV PERL_CALLCONV
-# define MY_BASE_CALLCONV_S "PERL_CALLCONV"
+# define Q_BASE_CALLCONV PERL_CALLCONV
+# define Q_BASE_CALLCONV_S "PERL_CALLCONV"
#endif /* !(WIN32 && >= 5.13.6) */
-#define MY_EXPORT_CALLCONV MY_BASE_CALLCONV
+#define Q_EXPORT_CALLCONV Q_BASE_CALLCONV
#if defined(WIN32) || defined(__CYGWIN__)
-# define MY_IMPORT_CALLCONV_S MY_BASE_CALLCONV_S" __declspec(dllimport)"
+# define Q_IMPORT_CALLCONV_S Q_BASE_CALLCONV_S " __declspec(dllimport)"
#else
-# define MY_IMPORT_CALLCONV_S MY_BASE_CALLCONV_S
+# define Q_IMPORT_CALLCONV_S Q_BASE_CALLCONV_S
#endif
#ifndef rv2cv_op_cv
+# define Q_RV2CV_CONST_REF_RESOLVES Q_PERL_VERSION_GE(5,11,2)
+
# define RV2CVOPCV_MARK_EARLY 0x00000001
# define RV2CVOPCV_RETURN_NAME_GV 0x00000002
-# define Perl_rv2cv_op_cv QPFXD(roc0)
+# define Perl_rv2cv_op_cv Q_PFXD(roc0)
# define rv2cv_op_cv(cvop, flags) Perl_rv2cv_op_cv(aTHX_ cvop, flags)
-MY_EXPORT_CALLCONV CV *QPFXD(roc0)(pTHX_ OP *cvop, U32 flags)
+Q_EXPORT_CALLCONV CV *Q_PFXD(roc0)(pTHX_ OP *cvop, U32 flags)
{
OP *rvop;
CV *cv;
@@ -76,14 +99,14 @@ MY_EXPORT_CALLCONV CV *QPFXD(roc0)(pTHX_ OP *cvop, U32 flags)
return NULL;
}
} break;
-#if PERL_VERSION_GE(5,11,2)
+# if Q_RV2CV_CONST_REF_RESOLVES
case OP_CONST: {
SV *rv = cSVOPx_sv(rvop);
if(!SvROK(rv)) return NULL;
cv = (CV*)SvRV(rv);
gv = NULL;
} break;
-#endif /* >=5.11.2 */
+# endif /* Q_RV2CV_CONST_REF_RESOLVES */
default: {
return NULL;
} break;
@@ -125,6 +148,7 @@ static SV *THX_newSV_type(pTHX_ svtype type)
static OP *THX_entersub_extract_args(pTHX_ OP *entersubop)
{
OP *pushop, *aop, *bop, *cop;
+ PERL_UNUSED_THX();
if(!(entersubop->op_flags & OPf_KIDS)) return NULL;
pushop = cUNOPx(entersubop)->op_first;
if(!OpHAS_SIBLING(pushop)) {
@@ -177,17 +201,17 @@ static OP *THX_ck_entersub_args_stalk(pTHX_ OP *entersubop, OP *stalkcvop)
return entersubop;
}
-# define Perl_ck_entersub_args_list QPFXD(eal0)
+# define Perl_ck_entersub_args_list Q_PFXD(eal0)
# define ck_entersub_args_list(o) Perl_ck_entersub_args_list(aTHX_ o)
-MY_EXPORT_CALLCONV OP *QPFXD(eal0)(pTHX_ OP *entersubop)
+Q_EXPORT_CALLCONV OP *Q_PFXD(eal0)(pTHX_ OP *entersubop)
{
return ck_entersub_args_stalk(entersubop, newOP(OP_PADANY, 0));
}
-# define Perl_ck_entersub_args_proto QPFXD(eap0)
+# define Perl_ck_entersub_args_proto Q_PFXD(eap0)
# define ck_entersub_args_proto(o, gv, sv) \
Perl_ck_entersub_args_proto(aTHX_ o, gv, sv)
-MY_EXPORT_CALLCONV OP *QPFXD(eap0)(pTHX_ OP *entersubop, GV *namegv,
+Q_EXPORT_CALLCONV OP *Q_PFXD(eap0)(pTHX_ OP *entersubop, GV *namegv,
SV *protosv)
{
const char *proto;
@@ -206,10 +230,10 @@ MY_EXPORT_CALLCONV OP *QPFXD(eap0)(pTHX_ OP *entersubop, GV *namegv,
return ck_entersub_args_stalk(entersubop, newGVOP(OP_GV, 0, stalkgv));
}
-# define Perl_ck_entersub_args_proto_or_list QPFXD(ean0)
+# define Perl_ck_entersub_args_proto_or_list Q_PFXD(ean0)
# define ck_entersub_args_proto_or_list(o, gv, sv) \
Perl_ck_entersub_args_proto_or_list(aTHX_ o, gv, sv)
-MY_EXPORT_CALLCONV OP *QPFXD(ean0)(pTHX_ OP *entersubop, GV *namegv,
+Q_EXPORT_CALLCONV OP *Q_PFXD(ean0)(pTHX_ OP *entersubop, GV *namegv,
SV *protosv)
{
if(SvTYPE(protosv) == SVt_PVCV ? SvPOK(protosv) : SvOK(protosv))
@@ -244,6 +268,7 @@ MY_EXPORT_CALLCONV OP *QPFXD(ean0)(pTHX_ OP *entersubop, GV *namegv,
# define op_null(o) THX_op_null(aTHX_ o)
static void THX_op_null(pTHX_ OP *o)
{
+ PERL_UNUSED_THX();
if(o->op_type == OP_NULL) return;
/* must not be used on any op requiring non-trivial clearing */
o->op_targ = o->op_type;
@@ -257,6 +282,7 @@ static void THX_op_null(pTHX_ OP *o)
static MAGIC *THX_mg_findext(pTHX_ SV *sv, int type, MGVTBL const *vtbl)
{
MAGIC *mg;
+ PERL_UNUSED_THX();
if(sv)
for(mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
if(mg->mg_type == type && mg->mg_virtual == vtbl)
@@ -325,11 +351,11 @@ static MAGIC *THX_sv_magicext(pTHX_ SV *sv, SV *obj, int type,
# define PERL_MAGIC_ext '~'
# endif /* !PERL_MAGIC_ext */
-# if !PERL_VERSION_GE(5,9,3)
+# if Q_PERL_VERSION_LT(5,9,3)
typedef OP *(*Perl_check_t)(pTHX_ OP *);
# endif /* <5.9.3 */
-# if !PERL_VERSION_GE(5,10,1)
+# if Q_PERL_VERSION_LT(5,10,1)
typedef unsigned Optype;
# endif /* <5.10.1 */
@@ -338,6 +364,7 @@ typedef unsigned Optype;
static void THX_wrap_op_checker(pTHX_ Optype opcode,
Perl_check_t new_checker, Perl_check_t *old_checker_p)
{
+ PERL_UNUSED_THX();
if(*old_checker_p) return;
OP_REFCNT_LOCK;
if(!*old_checker_p) {
@@ -348,18 +375,19 @@ static void THX_wrap_op_checker(pTHX_ Optype opcode,
}
# endif /* !wrap_op_checker */
-static MGVTBL mgvtbl_checkcall;
+static MGVTBL const mgvtbl_checkcall;
typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);
-# define Perl_cv_get_call_checker QPFXD(gcc0)
+# define Perl_cv_get_call_checker Q_PFXD(gcc0)
# define cv_get_call_checker(cv, THX_ckfun_p, ckobj_p) \
Perl_cv_get_call_checker(aTHX_ cv, THX_ckfun_p, ckobj_p)
-MY_EXPORT_CALLCONV void QPFXD(gcc0)(pTHX_ CV *cv,
+Q_EXPORT_CALLCONV void Q_PFXD(gcc0)(pTHX_ CV *cv,
Perl_call_checker *THX_ckfun_p, SV **ckobj_p)
{
MAGIC *callmg = SvMAGICAL((SV*)cv) ?
- mg_findext((SV*)cv, PERL_MAGIC_ext, &mgvtbl_checkcall) : NULL;
+ mg_findext((SV*)cv, PERL_MAGIC_ext, (MGVTBL*)&mgvtbl_checkcall)
+ : NULL;
if(callmg) {
*THX_ckfun_p = DPTR2FPTR(Perl_call_checker, callmg->mg_ptr);
*ckobj_p = callmg->mg_obj;
@@ -369,23 +397,24 @@ MY_EXPORT_CALLCONV void QPFXD(gcc0)(pTHX_ CV *cv,
}
}
-# define Perl_cv_set_call_checker QPFXD(scc0)
+# define Perl_cv_set_call_checker Q_PFXD(scc0)
# define cv_set_call_checker(cv, THX_ckfun, ckobj) \
Perl_cv_set_call_checker(aTHX_ cv, THX_ckfun, ckobj)
-MY_EXPORT_CALLCONV void QPFXD(scc0)(pTHX_ CV *cv,
+Q_EXPORT_CALLCONV void Q_PFXD(scc0)(pTHX_ CV *cv,
Perl_call_checker THX_ckfun, SV *ckobj)
{
if(THX_ckfun == Perl_ck_entersub_args_proto_or_list &&
ckobj == (SV*)cv) {
if(SvMAGICAL((SV*)cv))
sv_unmagicext((SV*)cv, PERL_MAGIC_ext,
- &mgvtbl_checkcall);
+ (MGVTBL*)&mgvtbl_checkcall);
} else {
- MAGIC *callmg =
- mg_findext((SV*)cv, PERL_MAGIC_ext, &mgvtbl_checkcall);
+ MAGIC *callmg = mg_findext((SV*)cv, PERL_MAGIC_ext,
+ (MGVTBL*)&mgvtbl_checkcall);
if(!callmg)
callmg = sv_magicext((SV*)cv, &PL_sv_undef,
- PERL_MAGIC_ext, &mgvtbl_checkcall, NULL, 0);
+ PERL_MAGIC_ext,
+ (MGVTBL*)&mgvtbl_checkcall, NULL, 0);
if(callmg->mg_flags & MGf_REFCOUNTED) {
SvREFCNT_dec(callmg->mg_obj);
callmg->mg_flags &= ~MGf_REFCOUNTED;
@@ -443,50 +472,66 @@ BOOT:
SV *
callchecker0_h()
CODE:
+#if PERL_VERSION & 1
+# define Q_CODE_PERL_SUBVERSION_CRITERION \
+ " && PERL_SUBVERSION == " STRINGIFY(PERL_SUBVERSION)
+# define Q_TEXT_PERL_SUBVERSION_CRITERION "." STRINGIFY(PERL_SUBVERSION)
+#else /* !(PERL_VERSION & 1) */
+# define Q_CODE_PERL_SUBVERSION_CRITERION ""
+# define Q_TEXT_PERL_SUBVERSION_CRITERION ""
+#endif /* !(PERL_VERSION & 1) */
+#define Q_DEFFN(RETTYPE, PUBNAME, PRIVNAME, ARGTYPES, ARGNAMES) \
+ Q_IMPORT_CALLCONV_S " " RETTYPE " " \
+ Q_PFXS PRIVNAME "(pTHX_ " ARGTYPES ");\n" \
+ "#define Perl_" PUBNAME " " Q_PFXS PRIVNAME "\n" \
+ "#define " PUBNAME "(" ARGNAMES ") " \
+ "Perl_" PUBNAME "(aTHX_ " ARGNAMES ")\n"
+#if Q_PROVIDE_RV2CV_OP_CV
+# define Q_CODE_PROVIDE_RV2CV_OP_CV \
+ "#define RV2CVOPCV_MARK_EARLY 0x00000001\n" \
+ "#define RV2CVOPCV_RETURN_NAME_GV 0x00000002\n" \
+ Q_DEFFN("CV *", "rv2cv_op_cv", "roc0", "OP *, U32", "cvop, flags")
+#else /* !Q_PROVIDE_RV2CV_OP_CV */
+# define Q_CODE_PROVIDE_RV2CV_OP_CV ""
+#endif /* !Q_PROVIDE_RV2CV_OP_CV */
+#if Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST
+# define Q_CODE_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST \
+ Q_DEFFN("OP *", "ck_entersub_args_list", "eal0", "OP *", "o") \
+ Q_DEFFN("OP *", "ck_entersub_args_proto", "eap0", \
+ "OP *, GV *, SV *", "o, gv, sv") \
+ Q_DEFFN("OP *", "ck_entersub_args_proto_or_list", "ean0", \
+ "OP *, GV *, SV *", "o, gv, sv")
+#else /* !Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST */
+# define Q_CODE_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST ""
+#endif /* !Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST */
+#if Q_PROVIDE_CV_SET_CALL_CHECKER
+# define Q_CODE_PROVIDE_CV_SET_CALL_CHECKER \
+ "typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);\n" \
+ Q_DEFFN("void", "cv_get_call_checker", "gcc0", \
+ "CV *, Perl_call_checker *, SV **", "cv, fp, op") \
+ Q_DEFFN("void", "cv_set_call_checker", "scc0", \
+ "CV *, Perl_call_checker, SV *", "cv, f, o")
+#else /* !Q_PROVIDE_CV_SET_CALL_CHECKER */
+# define Q_CODE_PROVIDE_CV_SET_CALL_CHECKER ""
+#endif /* !Q_PROVIDE_CV_SET_CALL_CHECKER */
RETVAL = newSVpvs(
"/* DO NOT EDIT -- generated "
- "by Devel::CallChecker version "XS_VERSION" */\n"
- "#ifndef "QPFXS"INCLUDED\n"
- "#define "QPFXS"INCLUDED 1\n"
+ "by Devel::CallChecker version " XS_VERSION " */\n"
+ "#ifndef " Q_PFXS "INCLUDED\n"
+ "#define " Q_PFXS "INCLUDED 1\n"
"#ifndef PERL_VERSION\n"
" #error you must include perl.h before callchecker0.h\n"
- "#elif !(PERL_REVISION == "STRINGIFY(PERL_REVISION)
- " && PERL_VERSION == "STRINGIFY(PERL_VERSION)
-#if PERL_VERSION & 1
- " && PERL_SUBVERSION == "STRINGIFY(PERL_SUBVERSION)
-#endif /* PERL_VERSION & 1 */
- ")\n"
+ "#elif !(PERL_REVISION == " STRINGIFY(PERL_REVISION)
+ " && PERL_VERSION == " STRINGIFY(PERL_VERSION)
+ Q_CODE_PERL_SUBVERSION_CRITERION ")\n"
" #error this callchecker0.h is for Perl "
- STRINGIFY(PERL_REVISION)"."STRINGIFY(PERL_VERSION)
-#if PERL_VERSION & 1
- "."STRINGIFY(PERL_SUBVERSION)
-#endif /* PERL_VERSION & 1 */
- " only\n"
+ STRINGIFY(PERL_REVISION) "." STRINGIFY(PERL_VERSION)
+ Q_TEXT_PERL_SUBVERSION_CRITERION " only\n"
"#endif /* Perl version mismatch */\n"
-#define DEFFN(RETTYPE, PUBNAME, PRIVNAME, ARGTYPES, ARGNAMES) \
- MY_IMPORT_CALLCONV_S" "RETTYPE" "QPFXS PRIVNAME"(pTHX_ "ARGTYPES");\n" \
- "#define Perl_"PUBNAME" "QPFXS PRIVNAME"\n" \
- "#define "PUBNAME"("ARGNAMES") Perl_"PUBNAME"(aTHX_ "ARGNAMES")\n"
-#if Q_PROVIDE_RV2CV_OP_CV
- "#define RV2CVOPCV_MARK_EARLY 0x00000001\n"
- "#define RV2CVOPCV_RETURN_NAME_GV 0x00000002\n"
- DEFFN("CV *", "rv2cv_op_cv", "roc0", "OP *, U32", "cvop, flags")
-#endif /* Q_PROVIDE_RV2CV_OP_CV */
-#if Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST
- DEFFN("OP *", "ck_entersub_args_list", "eal0", "OP *", "o")
- DEFFN("OP *", "ck_entersub_args_proto", "eap0",
- "OP *, GV *, SV *", "o, gv, sv")
- DEFFN("OP *", "ck_entersub_args_proto_or_list", "ean0",
- "OP *, GV *, SV *", "o, gv, sv")
-#endif /* Q_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST */
-#if Q_PROVIDE_CV_SET_CALL_CHECKER
- "typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);\n"
- DEFFN("void", "cv_get_call_checker", "gcc0",
- "CV *, Perl_call_checker *, SV **", "cv, fp, op")
- DEFFN("void", "cv_set_call_checker", "scc0",
- "CV *, Perl_call_checker, SV *", "cv, f, o")
-#endif /* Q_PROVIDE_CV_SET_CALL_CHECKER */
- "#endif /* !"QPFXS"INCLUDED */\n"
+ Q_CODE_PROVIDE_RV2CV_OP_CV
+ Q_CODE_PROVIDE_CK_ENTERSUB_ARGS_PROTO_OR_LIST
+ Q_CODE_PROVIDE_CV_SET_CALL_CHECKER
+ "#endif /* !" Q_PFXS "INCLUDED */\n"
);
OUTPUT:
RETVAL
diff --git a/t/callck.xs b/t/callck.xs
index 2e7b0ec..d617ae9 100644
--- a/t/callck.xs
+++ b/t/callck.xs
@@ -4,18 +4,33 @@
#include "callck_callchecker0.h"
#include "XSUB.h"
-#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_DECIMAL(r,v,s) ((r)*1000000 + (v)*1000 + (s))
+#define Q_PERL_DECIMAL_VERSION \
+ Q_PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define Q_PERL_VERSION_GE(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION >= Q_PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_LT(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION < Q_PERL_VERSION_DECIMAL(r,v,s))
+
+#if (Q_PERL_VERSION_GE(5,17,6) && Q_PERL_VERSION_LT(5,17,11)) || \
+ (Q_PERL_VERSION_GE(5,19,3) && Q_PERL_VERSION_LT(5,21,1))
+PERL_STATIC_INLINE void suppress_unused_warning(void)
+{
+ (void) S_croak_memory_wrap;
+}
+#endif /* (>=5.17.6 && <5.17.11) || (>=5.19.3 && <5.21.1) */
+
+#if Q_PERL_VERSION_LT(5,7,2)
+# undef dNOOP
+# define dNOOP extern int Perl___notused_func(void)
+#endif /* <5.7.2 */
#ifndef cBOOL
# define cBOOL(x) ((bool)!!(x))
#endif /* !cBOOL */
#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
+# define PERL_UNUSED_VAR(x) ((void)(x))
#endif /* !PERL_UNUSED_VAR */
#ifndef PERL_UNUSED_ARG
@@ -122,12 +137,12 @@ PREINIT:
Perl_call_checker ckfun;
SV *ckobj;
CODE:
-#define croak_fail() croak("fail at " __FILE__ " line %d", __LINE__)
+#define croak_fail() croak("fail at %s line %d", __FILE__, __LINE__)
#define croak_fail_ne(h, w) \
- croak("fail %p!=%p at " __FILE__ " line %d", (h), (w), __LINE__)
-#define check_cc(cv, xckfun, xckobj) \
+ croak("fail %p!=%p at %s line %d", (h), (w), __FILE__, __LINE__)
+#define check_cc(pcv, xckfun, xckobj) \
do { \
- cv_get_call_checker((cv), &ckfun, &ckobj); \
+ cv_get_call_checker((pcv), &ckfun, &ckobj); \
if (ckfun != (xckfun)) \
croak_fail_ne(FPTR2DPTR(void *, ckfun), xckfun); \
if (ckobj != (xckobj)) \
@@ -171,35 +186,35 @@ CODE:
;
void
-cv_set_call_checker_lists(CV *cv)
+cv_set_call_checker_lists(CV *pcv)
PROTOTYPE: $
CODE:
- cv_set_call_checker(cv, THX_ck_entersub_args_lists, &PL_sv_undef);
+ cv_set_call_checker(pcv, THX_ck_entersub_args_lists, &PL_sv_undef);
void
-cv_set_call_checker_scalars(CV *cv)
+cv_set_call_checker_scalars(CV *pcv)
PROTOTYPE: $
CODE:
- cv_set_call_checker(cv, THX_ck_entersub_args_scalars, &PL_sv_undef);
+ cv_set_call_checker(pcv, THX_ck_entersub_args_scalars, &PL_sv_undef);
void
-cv_set_call_checker_proto(CV *cv, SV *proto)
+cv_set_call_checker_proto(CV *pcv, SV *proto)
PROTOTYPE: $$
CODE:
if (SvROK(proto))
proto = SvRV(proto);
- cv_set_call_checker(cv, Perl_ck_entersub_args_proto, proto);
+ cv_set_call_checker(pcv, Perl_ck_entersub_args_proto, proto);
void
-cv_set_call_checker_proto_or_list(CV *cv, SV *proto)
+cv_set_call_checker_proto_or_list(CV *pcv, SV *proto)
PROTOTYPE: $$
CODE:
if (SvROK(proto))
proto = SvRV(proto);
- cv_set_call_checker(cv, Perl_ck_entersub_args_proto_or_list, proto);
+ cv_set_call_checker(pcv, Perl_ck_entersub_args_proto_or_list, proto);
void
-cv_set_call_checker_multi_sum(CV *cv)
+cv_set_call_checker_multi_sum(CV *pcv)
PROTOTYPE: $
CODE:
- cv_set_call_checker(cv, THX_ck_entersub_multi_sum, &PL_sv_undef);
+ cv_set_call_checker(pcv, THX_ck_entersub_multi_sum, &PL_sv_undef);
diff --git a/t/rv2cvopcv.xs b/t/rv2cvopcv.xs
index ca1f72e..8f38dfd 100644
--- a/t/rv2cvopcv.xs
+++ b/t/rv2cvopcv.xs
@@ -4,11 +4,28 @@
#include "rv2cvopcv_callchecker0.h"
#include "XSUB.h"
-#define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_DECIMAL(r,v,s) ((r)*1000000 + (v)*1000 + (s))
+#define Q_PERL_DECIMAL_VERSION \
+ Q_PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define Q_PERL_VERSION_GE(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION >= Q_PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_LT(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION < Q_PERL_VERSION_DECIMAL(r,v,s))
+
+#if (Q_PERL_VERSION_GE(5,17,6) && Q_PERL_VERSION_LT(5,17,11)) || \
+ (Q_PERL_VERSION_GE(5,19,3) && Q_PERL_VERSION_LT(5,21,1))
+PERL_STATIC_INLINE void suppress_unused_warning(void)
+{
+ (void) S_croak_memory_wrap;
+}
+#endif /* (>=5.17.6 && <5.17.11) || (>=5.19.3 && <5.21.1) */
+
+#if Q_PERL_VERSION_LT(5,7,2)
+# undef dNOOP
+# define dNOOP extern int Perl___notused_func(void)
+#endif /* <5.7.2 */
+
+#define Q_RV2CV_CONST_REF_RESOLVES Q_PERL_VERSION_GE(5,11,2)
MODULE = t::rv2cvopcv PACKAGE = t::rv2cvopcv
@@ -22,7 +39,7 @@ PREINIT:
CV *troc_cv;
OP *o;
CODE:
-#define croak_fail() croak("fail at " __FILE__ " line %d", __LINE__)
+#define croak_fail() croak("fail at %s line %d", __FILE__, __LINE__)
troc_gv = gv_fetchpv("t::rv2cvopcv::test_rv2cv_op_cv", 0, SVt_PVGV);
troc_cv = get_cv("t::rv2cvopcv::test_rv2cv_op_cv", 0);
(void) gv_fetchpv("t::rv2cvopcv::wibble", 0, SVt_PVGV);
@@ -49,24 +66,24 @@ CODE:
if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
op_free(o);
o = newCVREF(0, newSVOP(OP_CONST, 0, newRV_inc((SV*)troc_cv)));
-#if PERL_VERSION_GE(5,11,2)
+#if Q_RV2CV_CONST_REF_RESOLVES
if (rv2cv_op_cv(o, 0) != troc_cv) croak_fail();
if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV) != (CV*)troc_gv)
croak_fail();
-#else /* <5.11.2 */
+#else /* !Q_RV2CV_CONST_REF_RESOLVES */
if (rv2cv_op_cv(o, 0)) croak_fail();
if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
-#endif /* <5.11.2 */
+#endif /* !Q_RV2CV_CONST_REF_RESOLVES */
o->op_private |= OPpENTERSUB_AMPER;
if (rv2cv_op_cv(o, 0)) croak_fail();
if (rv2cv_op_cv(o, RV2CVOPCV_RETURN_NAME_GV)) croak_fail();
o->op_private &= ~OPpENTERSUB_AMPER;
if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
-#if PERL_VERSION_GE(5,11,2)
+#if Q_RV2CV_CONST_REF_RESOLVES
if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY) != troc_cv) croak_fail();
-#else /* <5.11.2 */
+#else /* !Q_RV2CV_CONST_REF_RESOLVES */
if (rv2cv_op_cv(o, RV2CVOPCV_MARK_EARLY)) croak_fail();
-#endif /* <5.11.2 */
+#endif /* !Q_RV2CV_CONST_REF_RESOLVES */
if (cUNOPx(o)->op_first->op_private & OPpEARLY_CV) croak_fail();
op_free(o);
o = newCVREF(0, newUNOP(OP_RAND, 0, newSVOP(OP_CONST, 0, newSViv(0))));
diff --git a/t/threads.t b/t/threads.t
index 2acea5c..ee79c76 100644
--- a/t/threads.t
+++ b/t/threads.t
@@ -11,6 +11,22 @@ BEGIN {
require Test::More;
Test::More::plan(skip_all => "threads unavailable");
}
+ if("$]" < 5.008003) {
+ require Test::More;
+ Test::More::plan(skip_all =>
+ "threading breaks PL_sv_placeholder on this Perl");
+ }
+ if("$]" < 5.008009) {
+ require Test::More;
+ Test::More::plan(skip_all =>
+ "threading corrupts memory on this Perl");
+ }
+
+ if("$]" >= 5.009005 && "$]" < 5.010001) {
+ require Test::More;
+ Test::More::plan(skip_all =>
+ "threading breaks assertions on this Perl");
+ }
eval { require Thread::Semaphore; };
if($@ ne "") {
require Test::More;
@@ -25,69 +41,68 @@ BEGIN {
use threads;
-BEGIN { unshift @INC, "./t/lib"; }
use Test::More tests => 3;
use Thread::Semaphore ();
use threads::shared;
alarm 10; # failure mode may involve an infinite loop
+my(@exit_sems, @threads);
+
+sub test_in_thread($) {
+ my($test_code) = @_;
+ my $done_sem = Thread::Semaphore->new(0);
+ my $exit_sem = Thread::Semaphore->new(0);
+ push @exit_sems, $exit_sem;
+ my $ok :shared;
+ push @threads, threads->create(sub {
+ $ok = !!$test_code->();
+ $done_sem->up;
+ $exit_sem->down;
+ });
+ $done_sem->down;
+ ok $ok;
+}
+
+BEGIN { unshift @INC, "./t/lib"; }
+
sub tsub1 (@) { $_[0] }
sub tsub2 (@) { $_[0] }
sub nsub (@) { $_[0] }
our @three = (3);
-my $done1 = Thread::Semaphore->new(0);
-my $exit1 = Thread::Semaphore->new(0);
-my $done2 = Thread::Semaphore->new(0);
-my $exit2 = Thread::Semaphore->new(0);
-
-my $ok1 :shared;
-my $thread1 = threads->create(sub {
- my $ok = 1;
+test_in_thread(sub {
require Devel::CallChecker;
require t::LoadXS;
require t::WriteHeader;
t::WriteHeader::write_header("callchecker0", "t", "threads1");
t::LoadXS::load_xs("threads1", "t",
[Devel::CallChecker::callchecker_linkable()]);
- eval(q{nsub(@three)}) == 3 or $ok = 0;
- eval(q{tsub1(@three)}) == 3 or $ok = 0;
+ eval(q{nsub(@three)}) == 3 or return 0;
+ eval(q{tsub1(@three)}) == 3 or return 0;
t::threads1::cv_set_call_checker_proto(\&tsub1, "\$");
- eval(q{nsub(@three)}) == 3 or $ok = 0;
- eval(q{tsub1(@three)}) == 1 or $ok = 0;
- $ok1 = $ok;
- $done1->up;
- $exit1->down;
+ eval(q{nsub(@three)}) == 3 or return 0;
+ eval(q{tsub1(@three)}) == 1 or return 0;
+ return 1;
});
-$done1->down;
-ok $ok1;
-my $ok2 :shared;
-my $thread2 = threads->create(sub {
- my $ok = 1;
+test_in_thread(sub {
require Devel::CallChecker;
require t::LoadXS;
require t::WriteHeader;
t::WriteHeader::write_header("callchecker0", "t", "threads2");
t::LoadXS::load_xs("threads2", "t",
[Devel::CallChecker::callchecker_linkable()]);
- eval(q{nsub(@three)}) == 3 or $ok = 0;
- eval(q{tsub2(@three)}) == 3 or $ok = 0;
+ eval(q{nsub(@three)}) == 3 or return 0;
+ eval(q{tsub2(@three)}) == 3 or return 0;
t::threads2::cv_set_call_checker_proto(\&tsub2, "\$");
- eval(q{nsub(@three)}) == 3 or $ok = 0;
- eval(q{tsub2(@three)}) == 1 or $ok = 0;
- $ok2 = $ok;
- $done2->up;
- $exit2->down;
+ eval(q{nsub(@three)}) == 3 or return 0;
+ eval(q{tsub2(@three)}) == 1 or return 0;
+ return 1;
});
-$done2->down;
-ok $ok2;
-$exit1->up;
-$exit2->up;
-$thread1->join;
-$thread2->join;
+$_->up foreach @exit_sems;
+$_->join foreach @threads;
ok 1;
1;
diff --git a/t/threads1.xs b/t/threads1.xs
index 863b9b0..47807b2 100644
--- a/t/threads1.xs
+++ b/t/threads1.xs
@@ -4,14 +4,35 @@
#include "threads1_callchecker0.h"
#include "XSUB.h"
+#define Q_PERL_VERSION_DECIMAL(r,v,s) ((r)*1000000 + (v)*1000 + (s))
+#define Q_PERL_DECIMAL_VERSION \
+ Q_PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define Q_PERL_VERSION_GE(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION >= Q_PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_LT(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION < Q_PERL_VERSION_DECIMAL(r,v,s))
+
+#if (Q_PERL_VERSION_GE(5,17,6) && Q_PERL_VERSION_LT(5,17,11)) || \
+ (Q_PERL_VERSION_GE(5,19,3) && Q_PERL_VERSION_LT(5,21,1))
+PERL_STATIC_INLINE void suppress_unused_warning(void)
+{
+ (void) S_croak_memory_wrap;
+}
+#endif /* (>=5.17.6 && <5.17.11) || (>=5.19.3 && <5.21.1) */
+
+#if Q_PERL_VERSION_LT(5,7,2)
+# undef dNOOP
+# define dNOOP extern int Perl___notused_func(void)
+#endif /* <5.7.2 */
+
MODULE = t::threads1 PACKAGE = t::threads1
PROTOTYPES: DISABLE
void
-cv_set_call_checker_proto(CV *cv, SV *proto)
+cv_set_call_checker_proto(CV *pcv, SV *proto)
PROTOTYPE: $$
CODE:
if (SvROK(proto))
proto = SvRV(proto);
- cv_set_call_checker(cv, Perl_ck_entersub_args_proto, proto);
+ cv_set_call_checker(pcv, Perl_ck_entersub_args_proto, proto);
diff --git a/t/threads2.xs b/t/threads2.xs
index 008b065..3da48ed 100644
--- a/t/threads2.xs
+++ b/t/threads2.xs
@@ -4,14 +4,35 @@
#include "threads2_callchecker0.h"
#include "XSUB.h"
+#define Q_PERL_VERSION_DECIMAL(r,v,s) ((r)*1000000 + (v)*1000 + (s))
+#define Q_PERL_DECIMAL_VERSION \
+ Q_PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
+#define Q_PERL_VERSION_GE(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION >= Q_PERL_VERSION_DECIMAL(r,v,s))
+#define Q_PERL_VERSION_LT(r,v,s) \
+ (Q_PERL_DECIMAL_VERSION < Q_PERL_VERSION_DECIMAL(r,v,s))
+
+#if (Q_PERL_VERSION_GE(5,17,6) && Q_PERL_VERSION_LT(5,17,11)) || \
+ (Q_PERL_VERSION_GE(5,19,3) && Q_PERL_VERSION_LT(5,21,1))
+PERL_STATIC_INLINE void suppress_unused_warning(void)
+{
+ (void) S_croak_memory_wrap;
+}
+#endif /* (>=5.17.6 && <5.17.11) || (>=5.19.3 && <5.21.1) */
+
+#if Q_PERL_VERSION_LT(5,7,2)
+# undef dNOOP
+# define dNOOP extern int Perl___notused_func(void)
+#endif /* <5.7.2 */
+
MODULE = t::threads2 PACKAGE = t::threads2
PROTOTYPES: DISABLE
void
-cv_set_call_checker_proto(CV *cv, SV *proto)
+cv_set_call_checker_proto(CV *pcv, SV *proto)
PROTOTYPE: $$
CODE:
if (SvROK(proto))
proto = SvRV(proto);
- cv_set_call_checker(cv, Perl_ck_entersub_args_proto, proto);
+ cv_set_call_checker(pcv, Perl_ck_entersub_args_proto, proto);
Debdiff
[The following lists of changes regard files as different if they have different names, permissions or owners.]
Files in second set of .debs but not in first
-rw-r--r-- root/root /usr/lib/debug/.build-id/c4/67a8653f66b38596efe2e502e0c29511a78605.debug
Files in first set of .debs but not in second
-rw-r--r-- root/root /usr/lib/debug/.build-id/4d/25fc31df0550bd82d3b9708416c4b0f27e07b6.debug
No differences were encountered between the control files of package libdevel-callchecker-perl
Control files of package libdevel-callchecker-perl-dbgsym: lines which differ (wdiff format)
Build-Ids: 4d25fc31df0550bd82d3b9708416c4b0f27e07b6 c467a8653f66b38596efe2e502e0c29511a78605