Fix potential memory corruption during Perl global destruction During global destruction, DESTROY is called in random order on objects remaining because of refcount leaks or circular references. This can cause memory corruption with Clownfish objects, so better leak instead of corrupting memory.
Fixes CLOWNFISH-117. Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/4aea9977 Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/4aea9977 Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/4aea9977 Branch: refs/heads/master Commit: 4aea9977c3d25a550cd72d95a4e2493da3711a3a Parents: fbbc859 Author: Nick Wellnhofer <wellnho...@aevum.de> Authored: Thu Feb 23 16:15:14 2017 +0100 Committer: Nick Wellnhofer <wellnho...@aevum.de> Committed: Thu Feb 23 16:35:50 2017 +0100 ---------------------------------------------------------------------- .../perl/buildlib/Clownfish/Build/Binding.pm | 22 ++++++--- runtime/perl/t/binding/019-obj.t | 16 ++++++- runtime/test/Clownfish/Test/RefObj.c | 47 ++++++++++++++++++++ runtime/test/Clownfish/Test/RefObj.cfh | 34 ++++++++++++++ 4 files changed, 113 insertions(+), 6 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/4aea9977/runtime/perl/buildlib/Clownfish/Build/Binding.pm ---------------------------------------------------------------------- diff --git a/runtime/perl/buildlib/Clownfish/Build/Binding.pm b/runtime/perl/buildlib/Clownfish/Build/Binding.pm index 61c0abe..4a00766 100644 --- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm +++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm @@ -640,6 +640,8 @@ END_XS_CODE } sub bind_obj { + my @hand_rolled = qw( Destroy ); + my $pod_spec = Clownfish::CFC::Binding::Perl::Pod->new; my $synopsis = <<'END_SYNOPSIS'; package MyObj; @@ -737,7 +739,6 @@ END_POD pod => $to_perl_pod, ); $pod_spec->add_method( - method => 'Destroy', alias => 'DESTROY', pod => $destroy_pod, ); @@ -745,6 +746,20 @@ END_POD my $xs_code = <<'END_XS_CODE'; MODULE = Clownfish PACKAGE = Clownfish::Obj +void +DESTROY(self) + cfish_Obj *self +PPCODE: + /* + * During global destruction, DESTROY is called in random order on + * objects remaining because of refcount leaks or circular references. + * This can cause memory corruption with Clownfish objects, so better + * leak instead of corrupting memory. + */ + if (!PL_dirty) { + CFISH_Obj_Destroy(self); + } + SV* get_class(self) cfish_Obj *self @@ -790,12 +805,9 @@ END_XS_CODE my $binding = Clownfish::CFC::Binding::Perl::Class->new( class_name => "Clownfish::Obj", ); - $binding->bind_method( - alias => 'DESTROY', - method => 'Destroy', - ); $binding->append_xs($xs_code); $binding->set_pod_spec($pod_spec); + $binding->exclude_method($_) for @hand_rolled; Clownfish::CFC::Binding::Perl::Class->register($binding); } http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/4aea9977/runtime/perl/t/binding/019-obj.t ---------------------------------------------------------------------- diff --git a/runtime/perl/t/binding/019-obj.t b/runtime/perl/t/binding/019-obj.t index c5eec3b..357984b 100644 --- a/runtime/perl/t/binding/019-obj.t +++ b/runtime/perl/t/binding/019-obj.t @@ -16,7 +16,7 @@ use strict; use warnings; -use Test::More tests => 25; +use Test::More tests => 26; use Clownfish::Test; package TestObj; @@ -160,3 +160,17 @@ eval { SubclassFinalTestObj->new; }; like( $@, qr/Can't subclass final class Clownfish::Vector/, "Final class can't be subclassed" ); +SKIP: { + skip( "Circular references leak", 1 ) + if $ENV{CLOWNFISH_VALGRIND}; + + # Create a circular reference on purpose. These objects shouldn't be + # destroyed during Perl's global destruction because it could cause + # memory corruption. + my $ref1 = Clownfish::Test::RefObj->new; + my $ref2 = Clownfish::Test::RefObj->new; + $ref1->set_ref($ref2); + $ref2->set_ref($ref1); + pass ( "Created circular reference" ); +} + http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/4aea9977/runtime/test/Clownfish/Test/RefObj.c ---------------------------------------------------------------------- diff --git a/runtime/test/Clownfish/Test/RefObj.c b/runtime/test/Clownfish/Test/RefObj.c new file mode 100644 index 0000000..07d6825 --- /dev/null +++ b/runtime/test/Clownfish/Test/RefObj.c @@ -0,0 +1,47 @@ +/* Licensed to the Apache Software Foundation (ASF) under one or more + * contributor license agreements. See the NOTICE file distributed with + * this work for additional information regarding copyright ownership. + * The ASF licenses this file to You under the Apache License, Version 2.0 + * (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ + +#define C_TESTCFISH_REFOBJ +#define CFISH_USE_SHORT_NAMES +#define TESTCFISH_USE_SHORT_NAMES + +#include "Clownfish/Test/RefObj.h" +#include "Clownfish/Class.h" +#include "Clownfish/Err.h" + +RefObj* +RefObj_new() { + return (RefObj*)Class_Make_Obj(REFOBJ); +} + +void +RefObj_Set_Ref_IMP(RefObj *self, Obj *other) { + RefObjIVARS *const ivars = RefObj_IVARS(self); + Obj *temp = ivars->ref; + ivars->ref = INCREF(other); + DECREF(temp); +} + +void +RefObj_Destroy_IMP(RefObj *self) { + RefObjIVARS *const ivars = RefObj_IVARS(self); + if (cfish_get_refcount(self) > 1) { + THROW(ERR, "Destroy called on referenced object"); + } + DECREF(ivars->ref); + SUPER_DESTROY(self, REFOBJ); +} + http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/4aea9977/runtime/test/Clownfish/Test/RefObj.cfh ---------------------------------------------------------------------- diff --git a/runtime/test/Clownfish/Test/RefObj.cfh b/runtime/test/Clownfish/Test/RefObj.cfh new file mode 100644 index 0000000..4661203 --- /dev/null +++ b/runtime/test/Clownfish/Test/RefObj.cfh @@ -0,0 +1,34 @@ +/* Licensed to the Apache Software Foundation (ASF) under one or more + * contributor license agreements. See the NOTICE file distributed with + * this work for additional information regarding copyright ownership. + * The ASF licenses this file to You under the Apache License, Version 2.0 + * (the "License"); you may not use this file except in compliance with + * the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, software + * distributed under the License is distributed on an "AS IS" BASIS, + * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + * See the License for the specific language governing permissions and + * limitations under the License. + */ + +parcel TestClownfish; + +/** Object holding a reference to another object. + */ +class Clownfish::Test::RefObj { + + Obj *ref; + + inert incremented RefObj* + new(); + + void + Set_Ref(RefObj *self, Obj *other); + + public void + Destroy(RefObj *self); +} +