Skip to content

Commit dc38986

Browse files
committed
add API to test that libperl and the current executable are compatible
Issue #22125 detected that we weren't linking the correct library with the embedded test with gcc on OpenBSD, so add an API to perform a sanity check by comparing the size of the perl interpreter structure (or its size if it was a structure) and expected perl API version between those seen in the binary and those compiled into libperl.
1 parent 29cc805 commit dc38986

File tree

7 files changed

+72
-1
lines changed

7 files changed

+72
-1
lines changed

embed.fnc

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -663,6 +663,10 @@ Adp |SV * |amagic_deref_call \
663663
p |bool |amagic_is_enabled \
664664
|int method
665665

666+
CTdp |void |api_version_assert \
667+
|size_t interp_size \
668+
|NULLOK void *v_my_perl \
669+
|NN const char *api_version
666670
ETXip |void |append_utf8_from_native_byte \
667671
|const U8 byte \
668672
|NN U8 **dest

embed.h

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -128,6 +128,7 @@
128128
# define _to_utf8_upper_flags(a,b,c,d,e) Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e)
129129
# define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d)
130130
# define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b)
131+
# define api_version_assert Perl_api_version_assert
131132
# define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d)
132133
# define apply_builtin_cv_attributes(a,b) Perl_apply_builtin_cv_attributes(aTHX_ a,b)
133134
# define atfork_lock Perl_atfork_lock

lib/ExtUtils/t/Embed.t

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -158,7 +158,7 @@ $embed_test = "run/nodebug $exe" if $^O eq 'VMS';
158158
print "# embed_test = $embed_test\n";
159159
$status = system($embed_test);
160160
print (($status? 'not ':'')."ok 10 # system returned $status\n");
161-
unlink($exe,"embed_test.c",$obj);
161+
#unlink($exe,"embed_test.c",$obj);
162162
unlink("$exe.manifest") if $cl and $Config{'ccversion'} =~ /^(\d+)/ and $1 >= 14;
163163
unlink("$exe$Config{exe_ext}") if $skip_exe;
164164
unlink("embed_test.map","embed_test.lis") if $^O eq 'VMS';
@@ -196,6 +196,8 @@ int main(int argc, char **argv, char **env) {
196196
perl_construct(my_perl);
197197
PL_exit_flags |= PERL_EXIT_WARN;
198198
199+
PERL_API_VERSION_CHECK;
200+
199201
my_puts("ok 3");
200202
201203
perl_parse(my_perl, NULL, (sizeof(cmds)/sizeof(char *))-1, (char **)cmds, env);

perl.h

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9264,6 +9264,14 @@ END_EXTERN_C
92649264
# define PERL_STACK_REALIGN
92659265
#endif
92669266

9267+
#ifdef MULTIPLICITY
9268+
# define PERL_API_VERSION_ASSERT \
9269+
Perl_api_version_assert(sizeof(PerlInterpreter), aTHX, PERL_API_VERSION_STRING)
9270+
#else
9271+
# define PERL_API_VERSION_ASSERT \
9272+
Perl_api_version_assert(sizeof(PerlInterpreter), NULL, PERL_API_VERSION_STRING)
9273+
#endif
9274+
92679275
/*
92689276
92699277
(KEEP THIS LAST IN perl.h!)

pod/perldiag.pod

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4020,6 +4020,11 @@ See L</500 Server error>.
40204020
by a missing delimiter on a string or pattern, because it eventually
40214021
ended earlier on the current line.
40224022

4023+
=item Mismatch between expected and libperl %s
4024+
4025+
(F) For an embedded perl, the perl headers and configuration you built
4026+
your binary against don't match the library you've linked with.
4027+
40234028
=item Mismatched brackets in template
40244029

40254030
(F) A pack template could not be parsed because pairs of C<[...]> or

proto.h

Lines changed: 5 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

util.c

Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5737,6 +5737,52 @@ S_xs_version_bootcheck(pTHX_ SSize_t items, SSize_t ax, const char *xs_p,
57375737
}
57385738
}
57395739

5740+
/*
5741+
=for apidoc api_version_assert
5742+
5743+
Used by the PERL_API_VERSION_CHECK macro to compare the perl the
5744+
object was built with and the perl that C<libperl> was built with.
5745+
5746+
This can be used to ensure that these match and produces a more
5747+
diagnosable than random crashes and mis-behaviour.
5748+
5749+
=cut
5750+
*/
5751+
5752+
void
5753+
Perl_api_version_assert(size_t interp_size, void *v_my_perl,
5754+
const char *api_version) {
5755+
dTHX;
5756+
5757+
PERL_ARGS_ASSERT_API_VERSION_ASSERT;
5758+
5759+
if (interp_size != sizeof(PerlInterpreter)) {
5760+
/* detects various types of configuration mismatches */
5761+
/* diag_listed_as: Mismatch between expected and libperl %s */
5762+
Perl_croak(aTHX_
5763+
"Mismatch between expected and libperl interpreter structure size %zd vs %zd",
5764+
interp_size, sizeof(PerlInterpreter));
5765+
}
5766+
if (
5767+
#ifdef MULTIPLICITY
5768+
v_my_perl != my_perl
5769+
#else
5770+
v_my_perl != NULL
5771+
#endif
5772+
) {
5773+
/* detect threads vs non-threads mismatch */
5774+
/* diag_listed_as: Mismatch between expected and libperl %s */
5775+
Perl_croak(aTHX_
5776+
"Mismatch between expected and libperl interpreter pointer");
5777+
}
5778+
if (strNE(api_version, PERL_API_VERSION_STRING)) {
5779+
/* diag_listed_as: Mismatch between expected and libperl %s */
5780+
Perl_croak(aTHX_
5781+
"Mismatch between expected and libperl API versions %s vs %s",
5782+
api_version, PERL_API_VERSION_STRING);
5783+
}
5784+
}
5785+
57405786
PERL_STATIC_INLINE bool
57415787
S_gv_has_usable_name(pTHX_ GV *gv)
57425788
{

0 commit comments

Comments
 (0)