Fix a crash in when generating classes at run-time

This commit is contained in:
Petr Písař 2021-08-02 12:18:28 +02:00
parent 063b53d084
commit f2e99b52b4
2 changed files with 52 additions and 1 deletions

View File

@ -0,0 +1,47 @@
From: leonerd-cpan [...] leonerd.org.uk
https://rt.cpan.org/Public/Bug/Display.html?id=137952
--- old/src/class.c 2021-07-30 17:08:56 +0000
+++ new/src/class.c 2021-07-31 12:55:46 +0000
@@ -87,6 +87,9 @@
#define embed_cv(cv, embedding) S_embed_cv(aTHX_ cv, embedding)
static CV *S_embed_cv(pTHX_ CV *cv, RoleEmbedding *embedding)
{
+ assert(cv);
+ assert(CvOUTSIDE(cv));
+
CV *embedded_cv = cv_clone(cv);
SV *embeddingsv = embedding->embeddingsv;
@@ -358,6 +361,19 @@
ENTER;
+ if(!PL_compcv) {
+ /* We require the initslots CV to have a CvOUTSIDE, or else cv_clone()
+ * will segv when we compose role slots. Any class dynamically generated
+ * by string eval() will likely not get one, because it won't inherit a
+ * PL_compcv here. We'll fake it up
+ * See also https://rt.cpan.org/Ticket/Display.html?id=137952
+ */
+ SAVEVPTR(PL_compcv);
+ PL_compcv = find_runcv(0);
+
+ assert(PL_compcv);
+ }
+
I32 floor_ix = start_subparse(FALSE, 0);
SAVEFREESV(PL_compcv);
@@ -519,6 +535,9 @@
meta->initslots = newATTRSUB(floor_ix, NULL, NULL, NULL, ops);
+ assert(meta->initslots);
+ assert(CvOUTSIDE(meta->initslots));
+
LEAVE;
}

View File

@ -10,6 +10,9 @@ Summary: Simple syntax for lexical slot-based objects
License: GPL+ or Artistic
URL: https://metacpan.org/release/Object-Pad
Source0: https://cpan.metacpan.org/authors/id/P/PE/PEVANS/Object-Pad-%{version}.tar.gz
# Fix a crash in when generating classes at run-time, CPAN RT#137952,
# proposed by the upstream
Patch0: Object-Pad-0.47-rt137952.patch
BuildRequires: coreutils
BuildRequires: perl-devel
BuildRequires: perl-generators
@ -95,7 +98,7 @@ Tests from %{name}. Execute them
with "%{_libexecdir}/%{name}/test".
%prep
%setup -q -n Object-Pad-%{version}
%autosetup -p1 -n Object-Pad-%{version}
%if !%{with perl_Object_Pad_enables_optional_test} || %{defined perl_bootstrap}
for F in t/08subclass-Moo.t t/80async-method.t t/80dynamically+Object-Pad.t \
t/81async-method+dynamically.t t/90leak.t t/99pod.t; do
@ -142,6 +145,7 @@ export HARNESS_OPTIONS=j$(perl -e 'if ($ARGV[0] =~ /.*-j([0-9][0-9]*).*/) {print
%changelog
* Thu Jul 29 2021 Petr Pisar <ppisar@redhat.com> - 0.47-1
- 0.47 bump
- Fix a crash in when generating classes at run-time (CPAN RT#137952)
* Thu Jul 29 2021 Petr Pisar <ppisar@redhat.com> - 0.46-1
- 0.46 bump