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 <[email protected]> Authored: Sun Jul 27 17:24:00 2014 +0200 Committer: Nick Wellnhofer <[email protected]> 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
