Skip to content

Commit 5e485a6

Browse files
author
Tony Cook
committed
add API to test that libperl and the current executable are compatible
Issue Perl#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 d67896a commit 5e485a6

File tree

5 files changed

+50
-1
lines changed

5 files changed

+50
-1
lines changed

embed.fnc

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -658,6 +658,10 @@ Adp |SV * |amagic_deref_call \
658658
p |bool |amagic_is_enabled \
659659
|int method
660660

661+
EMTp |void |api_version_check \
662+
|size_t interp_size \
663+
|NULLOK void *v_my_perl \
664+
|NN const char *api_version
661665
ETXip |void |append_utf8_from_native_byte \
662666
|const U8 byte \
663667
|NN U8 **dest

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
@@ -9235,6 +9235,14 @@ END_EXTERN_C
92359235
# define PERL_STACK_REALIGN
92369236
#endif
92379237

9238+
#ifdef MULTIPLICITY
9239+
# define PERL_API_VERSION_CHECK \
9240+
Perl_api_version_check(sizeof(PerlInterpreter), aTHX, PERL_API_VERSION_STRING)
9241+
#else
9242+
# define PERL_API_VERSION_CHECK \
9243+
Perl_api_version_check(sizeof(PerlInterpreter), NULL, PERL_API_VERSION_STRING)
9244+
#endif
9245+
92389246
/*
92399247
92409248
(KEEP THIS LAST IN perl.h!)

proto.h

Lines changed: 6 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: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5698,6 +5698,35 @@ S_xs_version_bootcheck(pTHX_ SSize_t items, SSize_t ax, const char *xs_p,
56985698
}
56995699
}
57005700

5701+
void
5702+
Perl_api_version_check(size_t interp_size, void *v_my_perl,
5703+
const char *api_version) {
5704+
dTHX;
5705+
5706+
if (interp_size != sizeof(PerlInterpreter)) {
5707+
/* detects various types of configuration mismatches */
5708+
Perl_croak(aTHX_
5709+
"mismatch between expected and libperl interpreter structure size %zd vs %zd",
5710+
interp_size, sizeof(PerlInterpreter));
5711+
}
5712+
if (
5713+
#ifdef MULTIPLICITY
5714+
v_my_perl != my_perl
5715+
#else
5716+
v_my_perl != NULL
5717+
#endif
5718+
) {
5719+
/* detect threads vs non-threads mismatch */
5720+
Perl_croak(aTHX_
5721+
"mismatch between expected and libperl interpreter pointer");
5722+
}
5723+
if (strNE(api_version, PERL_API_VERSION_STRING)) {
5724+
Perl_croak(aTHX_
5725+
"mismatch between expected and libperl API versions %s vs %s",
5726+
api_version, PERL_API_VERSION_STRING);
5727+
}
5728+
}
5729+
57015730
PERL_STATIC_INLINE bool
57025731
S_gv_has_usable_name(pTHX_ GV *gv)
57035732
{

0 commit comments

Comments
 (0)