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/07/31 13:19:51 UTC
[3/4] git commit: Fix overriding of aliased methods
Fix overriding of aliased methods
Class_singleton must lookup the aliased name of Perl methods. Introduce
a new method Method#Host_Name that returns the name of a method in the
host language.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/64cf00e2
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/64cf00e2
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/64cf00e2
Branch: refs/heads/master
Commit: 64cf00e28a2a043eeeba115c272aaaa54935ae86
Parents: 0c2b1bc
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Sun Jul 27 17:24:00 2014 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Thu Jul 31 12:49:03 2014 +0200
----------------------------------------------------------------------
runtime/c/src/Clownfish/Method.c | 27 ++++++++++++++++
runtime/core/Clownfish/Class.c | 33 +++-----------------
runtime/core/Clownfish/Method.cfh | 3 ++
runtime/core/Clownfish/Test/TestObj.c | 13 ++++++++
runtime/core/Clownfish/Test/TestObj.cfh | 7 +++++
.../perl/buildlib/Clownfish/Build/Binding.pm | 13 ++++++++
runtime/perl/t/binding/019-obj.t | 19 ++++++++++-
runtime/perl/xs/XSBind.c | 33 ++++++++++++++++++++
8 files changed, 118 insertions(+), 30 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/runtime/c/src/Clownfish/Method.c
----------------------------------------------------------------------
diff --git a/runtime/c/src/Clownfish/Method.c b/runtime/c/src/Clownfish/Method.c
new file mode 100644
index 0000000..25e3b28
--- /dev/null
+++ b/runtime/c/src/Clownfish/Method.c
@@ -0,0 +1,27 @@
+/* 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 CFISH_USE_SHORT_NAMES
+#define C_CFISH_METHOD
+
+#include "Clownfish/Method.h"
+#include "Clownfish/String.h"
+
+String*
+Method_Host_Name_IMP(Method *self) {
+ return (String*)INCREF(self->name);
+}
+
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/runtime/core/Clownfish/Class.c
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Class.c b/runtime/core/Clownfish/Class.c
index 812b3e4..0220b3a 100644
--- a/runtime/core/Clownfish/Class.c
+++ b/runtime/core/Clownfish/Class.c
@@ -44,10 +44,6 @@
size_t Class_offset_of_parent = offsetof(Class, parent);
-// Remove spaces and underscores, convert to lower case.
-static String*
-S_scrunch_string(String *source);
-
static Method*
S_find_method(Class *self, const char *meth_name);
@@ -288,21 +284,19 @@ Class_singleton(String *class_name, Class *parent) {
Hash *meths = Hash_new(num_fresh);
for (uint32_t i = 0; i < num_fresh; i++) {
String *meth = (String*)VA_Fetch(fresh_host_methods, i);
- String *scrunched = S_scrunch_string(meth);
- Hash_Store(meths, (Obj*)scrunched, (Obj*)CFISH_TRUE);
- DECREF(scrunched);
+ Hash_Store(meths, (Obj*)meth, (Obj*)CFISH_TRUE);
}
for (Class *klass = parent; klass; klass = klass->parent) {
uint32_t max = VA_Get_Size(klass->methods);
for (uint32_t i = 0; i < max; i++) {
Method *method = (Method*)VA_Fetch(klass->methods, i);
if (method->callback_func) {
- String *scrunched = S_scrunch_string(method->name);
- if (Hash_Fetch(meths, (Obj*)scrunched)) {
+ String *name = Method_Host_Name(method);
+ if (Hash_Fetch(meths, (Obj*)name)) {
Class_Override(singleton, method->callback_func,
method->offset);
}
- DECREF(scrunched);
+ DECREF(name);
}
}
}
@@ -328,25 +322,6 @@ Class_singleton(String *class_name, Class *parent) {
return singleton;
}
-static String*
-S_scrunch_string(String *source) {
- CharBuf *buf = CB_new(Str_Get_Size(source));
- StringIterator *iter = Str_Top(source);
- int32_t code_point;
- while (STRITER_DONE != (code_point = StrIter_Next(iter))) {
- if (code_point > 127) {
- THROW(ERR, "Can't fold case for %o", source);
- }
- else if (code_point != '_') {
- CB_Cat_Char(buf, tolower(code_point));
- }
- }
- String *retval = CB_Yield_String(buf);
- DECREF(iter);
- DECREF(buf);
- return retval;
-}
-
bool
Class_add_to_registry(Class *klass) {
if (Class_registry == NULL) {
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/runtime/core/Clownfish/Method.cfh
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Method.cfh b/runtime/core/Clownfish/Method.cfh
index 4f73384..feab12f 100644
--- a/runtime/core/Clownfish/Method.cfh
+++ b/runtime/core/Clownfish/Method.cfh
@@ -43,6 +43,9 @@ class Clownfish::Method inherits Clownfish::Obj {
bool
Is_Excluded_From_Host(Method *self);
+ incremented String*
+ Host_Name(Method *self);
+
incremented Obj*
Inc_RefCount(Method *self);
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/runtime/core/Clownfish/Test/TestObj.c
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Test/TestObj.c b/runtime/core/Clownfish/Test/TestObj.c
index 1f6a470..a0ea072 100644
--- a/runtime/core/Clownfish/Test/TestObj.c
+++ b/runtime/core/Clownfish/Test/TestObj.c
@@ -178,4 +178,17 @@ TestObj_Run_IMP(TestObj *self, TestBatchRunner *runner) {
test_abstract_routines(runner);
}
+/*********************************************************************/
+
+String*
+AliasTestObj_Aliased_IMP(AliasTestObj *self) {
+ UNUSED_VAR(self);
+ return Str_newf("C");
+}
+
+String*
+AliasTestObj_Call_Aliased_From_C_IMP(AliasTestObj *self) {
+ UNUSED_VAR(self);
+ return AliasTestObj_Aliased(self);
+}
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/runtime/core/Clownfish/Test/TestObj.cfh
----------------------------------------------------------------------
diff --git a/runtime/core/Clownfish/Test/TestObj.cfh b/runtime/core/Clownfish/Test/TestObj.cfh
index eb4a0b6..958224b 100644
--- a/runtime/core/Clownfish/Test/TestObj.cfh
+++ b/runtime/core/Clownfish/Test/TestObj.cfh
@@ -26,4 +26,11 @@ class Clownfish::Test::TestObj
Run(TestObj *self, TestBatchRunner *runner);
}
+class Clownfish::Test::AliasTestObj {
+ incremented String*
+ Aliased(AliasTestObj *self);
+
+ incremented String*
+ Call_Aliased_From_C(AliasTestObj* self);
+}
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/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 f249aed..fba3def 100644
--- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm
+++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm
@@ -23,6 +23,7 @@ sub bind_all {
my $class = shift;
$class->bind_clownfish;
$class->bind_test;
+ $class->bind_test_alias_obj;
$class->bind_bytebuf;
$class->bind_string;
$class->bind_err;
@@ -112,6 +113,18 @@ END_XS_CODE
Clownfish::CFC::Binding::Perl::Class->register($binding);
}
+sub bind_test_alias_obj {
+ my $binding = Clownfish::CFC::Binding::Perl::Class->new(
+ parcel => "TestClownfish",
+ class_name => "Clownfish::Test::AliasTestObj",
+ );
+ $binding->bind_method(
+ alias => 'perl_alias',
+ method => 'Aliased',
+ );
+ Clownfish::CFC::Binding::Perl::Class->register($binding);
+}
+
sub bind_bytebuf {
my $xs_code = <<'END_XS_CODE';
MODULE = Clownfish PACKAGE = Clownfish::ByteBuf
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/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 347ea65..9d3b846 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 => 17;
+use Test::More tests => 20;
package TestObj;
use base qw( Clownfish::Obj );
@@ -49,6 +49,12 @@ use base qw( Clownfish::Obj );
sub DESTROY {}
}
+package OverriddenAliasTestObj;
+use base qw( Clownfish::Test::AliasTestObj );
+{
+ sub perl_alias {"Perl"}
+}
+
package main;
use Storable qw( freeze thaw );
@@ -117,3 +123,14 @@ SKIP: {
like( $@, qr/NULL/,
"Don't allow methods without nullable return values to return NULL" );
}
+
+my $alias_test = Clownfish::Test::AliasTestObj->new;
+is( $alias_test->perl_alias, 'C', "Host method aliases work" );
+
+eval { $alias_test->aliased; };
+like( $@, qr/aliased/, "Original method can't be called" );
+
+my $overridden_alias_test = OverriddenAliasTestObj->new;
+is( $overridden_alias_test->call_aliased_from_c, 'Perl',
+ 'Overriding aliased methods works' );
+
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/64cf00e2/runtime/perl/xs/XSBind.c
----------------------------------------------------------------------
diff --git a/runtime/perl/xs/XSBind.c b/runtime/perl/xs/XSBind.c
index 57c9381..d7c5e88 100644
--- a/runtime/perl/xs/XSBind.c
+++ b/runtime/perl/xs/XSBind.c
@@ -14,13 +14,17 @@
* limitations under the License.
*/
+#include <ctype.h>
+
#define C_CFISH_OBJ
#define C_CFISH_CLASS
#define C_CFISH_LOCKFREEREGISTRY
#define NEED_newRV_noinc
#include "charmony.h"
#include "XSBind.h"
+#include "Clownfish/CharBuf.h"
#include "Clownfish/LockFreeRegistry.h"
+#include "Clownfish/Method.h"
#include "Clownfish/Util/StringHelper.h"
#include "Clownfish/Util/NumberUtils.h"
#include "Clownfish/Util/Memory.h"
@@ -765,6 +769,35 @@ CFISH_Class_To_Host_IMP(cfish_Class *self) {
}
+/*************************** Clownfish::Method ******************************/
+
+cfish_String*
+CFISH_Method_Host_Name_IMP(cfish_Method *self) {
+ cfish_String *host_alias = CFISH_Method_Get_Host_Alias(self);
+ if (host_alias) {
+ return (cfish_String*)CFISH_INCREF(host_alias);
+ }
+
+ // Convert to lowercase.
+ cfish_String *name = CFISH_Method_Get_Name(self);
+ cfish_CharBuf *buf = cfish_CB_new(CFISH_Str_Get_Size(name));
+ cfish_StringIterator *iter = CFISH_Str_Top(name);
+ int32_t code_point;
+ while (CFISH_STRITER_DONE != (code_point = CFISH_StrIter_Next(iter))) {
+ if (code_point > 127) {
+ THROW(CFISH_ERR, "Can't lowercase '%o'", name);
+ }
+ else {
+ CFISH_CB_Cat_Char(buf, tolower(code_point));
+ }
+ }
+ cfish_String *retval = CFISH_CB_Yield_String(buf);
+ CFISH_DECREF(iter);
+ CFISH_DECREF(buf);
+
+ return retval;
+}
+
/***************************** Clownfish::Err *******************************/
// Anonymous XSUB helper for Err#trap(). It wraps the supplied C function