Perl_ckwarn(pTHX_ U32 w)
{
/* If lexical warnings have not been set, use $^W. */
- if (isLEXWARN_off)
- return PL_dowarn & G_WARN_ON;
+ if (isLEXWARN_off) {
+ /* TODO: Hardcoding this here sucks, see the commit that added this */
+ if (w == WARN_VOID_UNUSUAL)
+ return FALSE;
+ else
+ return PL_dowarn & G_WARN_ON;
+ }
return ckwarn_common(w);
}
Perl_ckwarn_d(pTHX_ U32 w)
{
/* If lexical warnings have not been set then default classes warn. */
- if (isLEXWARN_off)
- return TRUE;
+ if (isLEXWARN_off) {
+ /* TODO: Hardcoding this here sucks, see the commit that added this */
+ if (w == WARN_VOID_UNUSUAL)
+ return FALSE;
+ else
+ return TRUE;
+ }
return ckwarn_common(w);
}
static bool
S_ckwarn_common(pTHX_ U32 w)
{
- if (PL_curcop->cop_warnings == pWARN_ALL)
- return TRUE;
+ if (PL_curcop->cop_warnings == pWARN_ALL) {
+ /* TODO: Hardcoding this here sucks, see the commit that added this */
+ if (w == WARN_VOID_UNUSUAL)
+ return FALSE;
+ else
+ return TRUE;
+ }
if (PL_curcop->cop_warnings == pWARN_NONE)
return FALSE;
#endif /* PERL_IMPLICIT_CONTEXT */
-/* The meaning of the varargs is determined U32 key arg. This is not a format
- string. The U32 key is assembled with HS_KEY.
-
- v_my_perl arg is "PerlInterpreter * my_perl" if PERL_IMPLICIT_CONTEXT and
- otherwise "CV * cv" (boot xsub's CV *). v_my_perl will catch where a threaded
- future perl526.dll calling IO.dll for example, and IO.dll was linked with
- threaded perl524.dll, and both perl526.dll and perl524.dll are in %PATH and
- the Win32 DLL loader sucessfully can load IO.dll into the process but
- simultaniously it loaded a interp of a different version into the process,
- and XS code will naturally pass SV*s created by perl524.dll for perl526.dll
- to use through perl526.dll's my_perl->Istack_base.
-
- v_my_perl (v=void) can not be the first arg since then key will be out of
- place in a threaded vs non-threaded mixup and analyzing the key number's
- bitfields won't reveal the problem since it will be a valid key
- (unthreaded perl) on interp side, but croak reports the XS mod's key as
- gibberish (it is really my_perl ptr) (threaded XS mod), or if threaded perl
- and unthreaded XS module, threaded perl will look at uninit C stack or uninit
- register to get var key (remember it assumes 1st arg is interp cxt).
-
-Perl_xs_handshake(U32 key, void * v_my_perl, const char * file,
-[U32 items, U32 ax], [char * api_version], [char * xs_version]) */
+/* Perl_xs_handshake():
+ implement the various XS_*_BOOTCHECK macros, which are added to .c
+ files by ExtUtils::ParseXS, to check that the perl the module was built
+ with is binary compatible with the running perl.
+
+ usage:
+ Perl_xs_handshake(U32 key, void * v_my_perl, const char * file,
+ [U32 items, U32 ax], [char * api_version], [char * xs_version])
+
+ The meaning of the varargs is determined the U32 key arg (which is not
+ a format string). The fields of key are assembled by using HS_KEY().
+
+ Under PERL_IMPLICIT_CONTEX, the v_my_perl arg is of type
+ "PerlInterpreter *" and represents the callers context; otherwise it is
+ of type "CV *", and is the boot xsub's CV.
+
+ v_my_perl will catch where a threaded future perl526.dll calling IO.dll
+ for example, and IO.dll was linked with threaded perl524.dll, and both
+ perl526.dll and perl524.dll are in %PATH and the Win32 DLL loader
+ successfully can load IO.dll into the process but simultaneously it
+ loaded an interpreter of a different version into the process, and XS
+ code will naturally pass SV*s created by perl524.dll for perl526.dll to
+ use through perl526.dll's my_perl->Istack_base.
+
+ v_my_perl cannot be the first arg, since then 'key' will be out of
+ place in a threaded vs non-threaded mixup; and analyzing the key
+ number's bitfields won't reveal the problem, since it will be a valid
+ key (unthreaded perl) on interp side, but croak will report the XS mod's
+ key as gibberish (it is really a my_perl ptr) (threaded XS mod); or if
+ it's a threaded perl and an unthreaded XS module, threaded perl will
+ look at an uninit C stack or an uninit register to get 'key'
+ (remember that it assumes that the 1st arg is the interp cxt).
+
+ 'file' is the source filename of the caller.
+*/
+
I32
Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...)
{
if(UNLIKELY(got != need)) {
bad_handshake:/* recycle branch and string from above */
if(got != (void *)HSf_NOCHK)
- noperl_die("%s: Invalid handshake key got %p"
- " needed %p, binaries are mismatched",
+ noperl_die("%s: loadable library and perl binaries are mismatched"
+ " (got handshake key %p, needed %p)\n",
file, got, need);
}
return ax;
}
+
STATIC void
S_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p,
STRLEN xs_len)
/* BFD open and scan only if the filename changed. */
if (ctx->fname_prev == NULL ||
strNE(dl_info->dli_fname, ctx->fname_prev)) {
+ if (ctx->abfd) {
+ bfd_close(ctx->abfd);
+ }
ctx->abfd = bfd_openr(dl_info->dli_fname, 0);
if (ctx->abfd) {
if (bfd_check_format(ctx->abfd, bfd_object)) {
}
#ifdef USE_BFD
Safefree(symbol_names);
+ if (bfd_ctx.abfd) {
+ bfd_close(bfd_ctx.abfd);
+ }
#endif
Safefree(source_lines);
Safefree(source_name_sizes);
https://perl5.git.perl.org / perl5.git / blobdiff