You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by nw...@apache.org on 2014/08/03 17:47:15 UTC
[8/9] git commit: Clone class registry in new Perl threads
Clone class registry in new Perl threads
Define a CLONE method in Clownfish::Class which gets invoked when a new
Perl thread is created.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/b46a4465
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/b46a4465
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/b46a4465
Branch: refs/heads/clone_class_registry
Commit: b46a4465c8bf630eef7d2bfa4fdb5d3407d0b234
Parents: bfde91c
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Sun Aug 3 17:31:51 2014 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Sun Aug 3 17:46:02 2014 +0200
----------------------------------------------------------------------
runtime/core/Clownfish/Class.c | 26 ++++++++
runtime/core/Clownfish/Class.cfh | 3 +
.../perl/buildlib/Clownfish/Build/Binding.pm | 24 +++++++
runtime/perl/lib/Clownfish.pm | 2 +
runtime/perl/t/binding/600-threads.t | 70 ++++++++++++++++++++
5 files changed, 125 insertions(+)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b46a4465/runtime/core/Clownfish/Class.c
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Class.c b/runtime/core/Clownfish/Class.c
index a60aca9..8070fc1 100644
--- a/runtime/core/Clownfish/Class.c
+++ b/runtime/core/Clownfish/Class.c
@@ -355,6 +355,32 @@ Class_fetch_class(String *class_name) {
return (Class*)LFReg_Fetch(registry, (Obj*)class_name);
}
+LockFreeRegistry*
+Class_clone_registry(LockFreeRegistry *registry) {
+ LockFreeRegistry *twin = LFReg_Clone(registry);
+ LFRegIterator *iter = LFRegIter_new(twin);
+ Obj *value = NULL;
+
+ // Fix up parent pointers.
+ while (LFRegIter_Next(iter, NULL, &value)) {
+ Class *klass = (Class*)value;
+ Class *orig_parent = klass->parent;
+
+ if (orig_parent) {
+ String *parent_name = Class_Get_Name(orig_parent);
+ Class *twin_parent = (Class*)LFReg_Fetch(twin, (Obj*)parent_name);
+ if (!twin_parent) {
+ THROW(ERR, "Class '%o' not found in cloned registry",
+ parent_name);
+ }
+ klass->parent = twin_parent;
+ }
+ }
+ DECREF(iter);
+
+ return twin;
+}
+
void
Class_Add_Host_Method_Alias_IMP(Class *self, const char *alias,
const char *meth_name) {
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b46a4465/runtime/core/Clownfish/Class.cfh
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Class.cfh b/runtime/core/Clownfish/Class.cfh
index 69dc5a4..4229ff2 100644
--- a/runtime/core/Clownfish/Class.cfh
+++ b/runtime/core/Clownfish/Class.cfh
@@ -79,6 +79,9 @@ class Clownfish::Class inherits Clownfish::Obj {
inert nullable Class*
fetch_class(String *class_name);
+ inert LockFreeRegistry*
+ clone_registry(LockFreeRegistry *registry);
+
/** Given a class name, return the name of a parent class which descends
* from Clownfish::Obj, or NULL if such a class can't be found.
*/
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b46a4465/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 1b1d3c5..9b1d12e 100644
--- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm
+++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm
@@ -616,6 +616,30 @@ CODE:
RETVAL = (SV*)CFISH_Class_To_Host(singleton);
}
OUTPUT: RETVAL
+
+void
+CLONE(class_sv, ...)
+ SV *class_sv;
+PPCODE:
+{
+ const char *class_name = SvPV_nolen(class_sv);
+
+ if (strcmp(class_name, "Clownfish::Class") == 0) {
+ SV *registry_sv = get_sv("Clownfish::Class::_registry", 0);
+
+ if (registry_sv) {
+ cfish_LockFreeRegistry *registry;
+ SV *new_sv;
+
+ registry = (cfish_LockFreeRegistry*)XSBind_sv_to_cfish_obj(
+ registry_sv, CFISH_LOCKFREEREGISTRY, NULL);
+ registry = cfish_Class_clone_registry(registry);
+ new_sv = CFISH_Obj_To_Host((cfish_Obj*)registry);
+ sv_setsv(registry_sv, new_sv);
+ SvREFCNT_dec(new_sv);
+ }
+ }
+}
END_XS_CODE
my $binding = Clownfish::CFC::Binding::Perl::Class->new(
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b46a4465/runtime/perl/lib/Clownfish.pm
----------------------------------------------------------------------
diff --git a/runtime/perl/lib/Clownfish.pm b/runtime/perl/lib/Clownfish.pm
index 5f1bdd1..4109004 100644
--- a/runtime/perl/lib/Clownfish.pm
+++ b/runtime/perl/lib/Clownfish.pm
@@ -77,6 +77,8 @@ sub error {$Clownfish::Err::error}
our $VERSION = '0.003000';
$VERSION = eval $VERSION;
no warnings 'redefine';
+ # Clone LFReg manually.
+ sub CLONE_SKIP { 0; }
sub DESTROY { } # leak all
}
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/b46a4465/runtime/perl/t/binding/600-threads.t
----------------------------------------------------------------------
diff --git a/runtime/perl/t/binding/600-threads.t b/runtime/perl/t/binding/600-threads.t
new file mode 100644
index 0000000..42e11d7
--- /dev/null
+++ b/runtime/perl/t/binding/600-threads.t
@@ -0,0 +1,70 @@
+# 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.
+
+use strict;
+use warnings;
+
+use threads;
+
+use Clownfish;
+use Test::More tests => 7;
+
+sub cf_addr {
+ my $obj = shift;
+ return 0 + $$obj;
+}
+
+my $obj = Clownfish::String->new('A string.');
+my $registry_addr = cf_addr(Clownfish::Class->_get_registry);
+my $class = Clownfish::Class->fetch_class('Clownfish::Hash');
+my $class_addr = cf_addr($class);
+my $parent = $class->get_parent;
+my $parent_addr = cf_addr($parent);
+
+my ($thread) = threads->create(sub {
+ my $thr_registry = Clownfish::Class->_get_registry;
+ my $thr_class = Clownfish::Class->fetch_class('Clownfish::Hash');
+ my $thr_parent = $thr_class->get_parent;
+ my $thr_other_parent
+ = Clownfish::Class->fetch_class($thr_parent->get_name);
+ return (
+ defined($$obj),
+ cf_addr($thr_registry),
+ cf_addr($thr_class),
+ cf_addr($thr_parent),
+ cf_addr($thr_other_parent),
+ );
+});
+my (
+ $thr_obj_defined,
+ $thr_registry_addr,
+ $thr_class_addr,
+ $thr_parent_addr,
+ $thr_other_parent_addr,
+) = $thread->join;
+
+ok( !$thr_obj_defined, "Object is undefined in other thread" );
+
+my $other_registry_addr = cf_addr(Clownfish::Class->_get_registry);
+my $other_class = Clownfish::Class->fetch_class('Clownfish::Hash');
+my $other_class_addr = cf_addr($class);
+
+is( $other_registry_addr, $registry_addr, "Same registry in same thread" );
+is( $other_class_addr, $class_addr, "Same class in same thread" );
+isnt( $thr_registry_addr, $registry_addr, "Cloned registry in other thread" );
+isnt( $thr_class_addr, $class_addr, "Cloned class in other thread" );
+isnt( $thr_parent_addr, $parent_addr, "Cloned parent class in other thread" );
+is( $thr_parent_addr, $thr_other_parent_addr, "Parent classes fixed up" );
+