Skip to content

Commit 420c1c5

Browse files
Tony CookTony Cook
Tony Cook
authored and
Tony Cook
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 9e152df commit 420c1c5

File tree

5 files changed

+50
-1
lines changed

5 files changed

+50
-1
lines changed

embed.fnc

+4
Original file line numberDiff line numberDiff line change
@@ -686,6 +686,10 @@ Adp |SV * |amagic_deref_call \
686686
p |bool |amagic_is_enabled \
687687
|int method
688688

689+
EMTp |void |api_version_check \
690+
|size_t interp_size \
691+
|NULLOK void *v_my_perl \
692+
|NN const char *api_version
689693
ETXip |void |append_utf8_from_native_byte \
690694
|const U8 byte \
691695
|NN U8 **dest

lib/ExtUtils/t/Embed.t

+3-1
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

+8
Original file line numberDiff line numberDiff line change
@@ -9266,6 +9266,14 @@ END_EXTERN_C
92669266
# define PERL_STACK_REALIGN
92679267
#endif
92689268

9269+
#ifdef MULTIPLICITY
9270+
# define PERL_API_VERSION_CHECK \
9271+
Perl_api_version_check(sizeof(PerlInterpreter), aTHX, PERL_API_VERSION_STRING)
9272+
#else
9273+
# define PERL_API_VERSION_CHECK \
9274+
Perl_api_version_check(sizeof(PerlInterpreter), NULL, PERL_API_VERSION_STRING)
9275+
#endif
9276+
92699277
/*
92709278
92719279
(KEEP THIS LAST IN perl.h!)

proto.h

+6
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

util.c

+29
Original file line numberDiff line numberDiff line change
@@ -5686,6 +5686,35 @@ S_xs_version_bootcheck(pTHX_ SSize_t items, SSize_t ax, const char *xs_p,
56865686
}
56875687
}
56885688

5689+
void
5690+
Perl_api_version_check(size_t interp_size, void *v_my_perl,
5691+
const char *api_version) {
5692+
dTHX;
5693+
5694+
if (interp_size != sizeof(PerlInterpreter)) {
5695+
/* detects various types of configuration mismatches */
5696+
Perl_croak(aTHX_
5697+
"mismatch between expected and libperl interpreter structure size %zd vs %zd",
5698+
interp_size, sizeof(PerlInterpreter));
5699+
}
5700+
if (
5701+
#ifdef MULTIPLICITY
5702+
v_my_perl != my_perl
5703+
#else
5704+
v_my_perl != NULL
5705+
#endif
5706+
) {
5707+
/* detect threads vs non-threads mismatch */
5708+
Perl_croak(aTHX_
5709+
"mismatch between expected and libperl interpreter pointer");
5710+
}
5711+
if (strNE(api_version, PERL_API_VERSION_STRING)) {
5712+
Perl_croak(aTHX_
5713+
"mismatch between expected and libperl API versions %s vs %s",
5714+
api_version, PERL_API_VERSION_STRING);
5715+
}
5716+
}
5717+
56895718
PERL_STATIC_INLINE bool
56905719
S_gv_has_usable_name(pTHX_ GV *gv)
56915720
{

0 commit comments

Comments
 (0)