Skip to content

Commit 1b24aa4

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 9e152df commit 1b24aa4

File tree

6 files changed

+72
-1
lines changed

6 files changed

+72
-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!)

pod/perldiag.pod

+5
Original file line numberDiff line numberDiff line change
@@ -3972,6 +3972,11 @@ See L</500 Server error>.
39723972
by a missing delimiter on a string or pattern, because it eventually
39733973
ended earlier on the current line.
39743974

3975+
=item Mismatch between expected and libperl %s
3976+
3977+
(F) For an embedded perl, the perl headers and configuration you built
3978+
your binary against don't match the library you've linked with.
3979+
39753980
=item Mismatched brackets in template
39763981

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

proto.h

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

util.c

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

5689+
/*
5690+
=for apidoc api_version_check
5691+
5692+
Used by the PERL_API_VERSION_CHECK macro to compare the perl the
5693+
object was built with and the perl that C<libperl> was built with.
5694+
5695+
This can be used to ensure that these match and produces a more
5696+
diagnosable than random crashes and mis-behaviour.
5697+
5698+
=cut
5699+
*/
5700+
5701+
void
5702+
Perl_api_version_check(size_t interp_size, void *v_my_perl,
5703+
const char *api_version) {
5704+
dTHX;
5705+
5706+
PERL_ARGS_ASSERT_API_VERSION_CHECK;
5707+
5708+
if (interp_size != sizeof(PerlInterpreter)) {
5709+
/* detects various types of configuration mismatches */
5710+
/* diag_listed_as: Mismatch between expected and libperl %s */
5711+
Perl_croak(aTHX_
5712+
"Mismatch between expected and libperl interpreter structure size %zd vs %zd",
5713+
interp_size, sizeof(PerlInterpreter));
5714+
}
5715+
if (
5716+
#ifdef MULTIPLICITY
5717+
v_my_perl != my_perl
5718+
#else
5719+
v_my_perl != NULL
5720+
#endif
5721+
) {
5722+
/* detect threads vs non-threads mismatch */
5723+
/* diag_listed_as: Mismatch between expected and libperl %s */
5724+
Perl_croak(aTHX_
5725+
"Mismatch between expected and libperl interpreter pointer");
5726+
}
5727+
if (strNE(api_version, PERL_API_VERSION_STRING)) {
5728+
/* diag_listed_as: Mismatch between expected and libperl %s */
5729+
Perl_croak(aTHX_
5730+
"Mismatch between expected and libperl API versions %s vs %s",
5731+
api_version, PERL_API_VERSION_STRING);
5732+
}
5733+
}
5734+
56895735
PERL_STATIC_INLINE bool
56905736
S_gv_has_usable_name(pTHX_ GV *gv)
56915737
{

0 commit comments

Comments
 (0)