Skip to content

Commit bf42159

Browse files
tonycoztonycoz
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 5eb6a00 commit bf42159

7 files changed

Lines changed: 71 additions & 0 deletions

File tree

‎embed.fnc‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -800,6 +800,10 @@ Adp |SV * |amagic_deref_call \
800800
p |bool |amagic_is_enabled \
801801
|int method
802802

803+
CTdp |void |api_version_assert \
804+
|size_t interp_size \
805+
|NULLOK void *v_my_perl \
806+
|NN const char *api_version
803807
ETXip |void |append_utf8_from_native_byte \
804808
|const U8 byte \
805809
|NN U8 **dest

‎embed.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -61,6 +61,7 @@
6161
# define SvUV_nomg(a) Perl_SvUV_nomg(aTHX_ a)
6262
# define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d)
6363
# define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b)
64+
# define api_version_assert Perl_api_version_assert
6465
# define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d)
6566
# define apply_builtin_cv_attributes(a,b) Perl_apply_builtin_cv_attributes(aTHX_ a,b)
6667
# define atfork_child Perl_atfork_child

‎lib/ExtUtils/t/Embed.t‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -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
@@ -9276,6 +9276,14 @@ END_EXTERN_C
92769276
# define PERL_STACK_REALIGN
92779277
#endif
92789278

9279+
#ifdef MULTIPLICITY
9280+
# define PERL_API_VERSION_ASSERT \
9281+
Perl_api_version_assert(sizeof(PerlInterpreter), aTHX, PERL_API_VERSION_STRING)
9282+
#else
9283+
# define PERL_API_VERSION_ASSERT \
9284+
Perl_api_version_assert(sizeof(PerlInterpreter), NULL, PERL_API_VERSION_STRING)
9285+
#endif
9286+
92799287
/*
92809288
92819289
(KEEP THIS LAST IN perl.h!)

‎pod/perldiag.pod‎

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

4074+
=item Mismatch between expected and libperl %s
4075+
4076+
(F) For an embedded perl, the perl headers and configuration you built
4077+
your binary against don't match the library you've linked with.
4078+
40744079
=item Mismatched brackets in template
40754080

40764081
(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
@@ -5656,6 +5656,52 @@ S_xs_version_bootcheck(pTHX_ SSize_t items, SSize_t ax, const char *xs_p,
56565656
}
56575657
}
56585658

5659+
/*
5660+
=for apidoc api_version_assert
5661+
5662+
Used by the PERL_API_VERSION_CHECK macro to compare the perl the
5663+
object was built with and the perl that C<libperl> was built with.
5664+
5665+
This can be used to ensure that these match and produces a more
5666+
diagnosable than random crashes and mis-behaviour.
5667+
5668+
=cut
5669+
*/
5670+
5671+
void
5672+
Perl_api_version_assert(size_t interp_size, void *v_my_perl,
5673+
const char *api_version) {
5674+
dTHX;
5675+
5676+
PERL_ARGS_ASSERT_API_VERSION_ASSERT;
5677+
5678+
if (interp_size != sizeof(PerlInterpreter)) {
5679+
/* detects various types of configuration mismatches */
5680+
/* diag_listed_as: Mismatch between expected and libperl %s */
5681+
Perl_croak(aTHX_
5682+
"Mismatch between expected and libperl interpreter structure size %zd vs %zd",
5683+
interp_size, sizeof(PerlInterpreter));
5684+
}
5685+
if (
5686+
#ifdef MULTIPLICITY
5687+
v_my_perl != my_perl
5688+
#else
5689+
v_my_perl != NULL
5690+
#endif
5691+
) {
5692+
/* detect threads vs non-threads mismatch */
5693+
/* diag_listed_as: Mismatch between expected and libperl %s */
5694+
Perl_croak(aTHX_
5695+
"Mismatch between expected and libperl interpreter pointer");
5696+
}
5697+
if (strNE(api_version, PERL_API_VERSION_STRING)) {
5698+
/* diag_listed_as: Mismatch between expected and libperl %s */
5699+
Perl_croak(aTHX_
5700+
"Mismatch between expected and libperl API versions %s vs %s",
5701+
api_version, PERL_API_VERSION_STRING);
5702+
}
5703+
}
5704+
56595705
PERL_STATIC_INLINE bool
56605706
S_gv_has_usable_name(pTHX_ GV *gv)
56615707
{

0 commit comments

Comments
 (0)