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:49 UTC
[1/4] git commit: Use aliased method names in Perl callbacks
Repository: lucy-clownfish
Updated Branches:
refs/heads/master 811d2ef68 -> 2981de38d
Use aliased method names in Perl callbacks
Eliminate CFCMethod_micro_sym on the way.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/0c2b1bce
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/0c2b1bce
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/0c2b1bce
Branch: refs/heads/master
Commit: 0c2b1bcef4cad238a9a4e4c57740ffe1cf1f7aef
Parents: 7744424
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Sat Jul 26 20:36:17 2014 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Tue Jul 29 00:21:20 2014 +0200
----------------------------------------------------------------------
compiler/perl/lib/Clownfish/CFC.xs | 5 ++-
compiler/src/CFCMethod.c | 5 ---
compiler/src/CFCMethod.h | 3 --
compiler/src/CFCPerlClass.c | 8 +----
compiler/src/CFCPerlMethod.c | 64 ++++++++++++++++++++++-----------
compiler/src/CFCPerlMethod.h | 13 ++++---
6 files changed, 55 insertions(+), 43 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/perl/lib/Clownfish/CFC.xs
----------------------------------------------------------------------
diff --git a/compiler/perl/lib/Clownfish/CFC.xs b/compiler/perl/lib/Clownfish/CFC.xs
index b5734ce..c1983b7 100644
--- a/compiler/perl/lib/Clownfish/CFC.xs
+++ b/compiler/perl/lib/Clownfish/CFC.xs
@@ -2155,11 +2155,10 @@ OUTPUT: RETVAL
MODULE = Clownfish PACKAGE = Clownfish::CFC::Binding::Perl::Method
SV*
-_new(method, alias)
+_new(method)
CFCMethod *method;
- const char *alias;
CODE:
- CFCPerlMethod *self = CFCPerlMethod_new(method, alias);
+ CFCPerlMethod *self = CFCPerlMethod_new(method);
RETVAL = S_cfcbase_to_perlref(self);
CFCBase_decref((CFCBase*)self);
OUTPUT: RETVAL
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCMethod.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCMethod.c b/compiler/src/CFCMethod.c
index 0c89f68..2a1bba1 100644
--- a/compiler/src/CFCMethod.c
+++ b/compiler/src/CFCMethod.c
@@ -357,11 +357,6 @@ CFCMethod_get_macro_sym(CFCMethod *self) {
return self->macro_sym;
}
-const char*
-CFCMethod_micro_sym(CFCMethod *self) {
- return CFCSymbol_micro_sym((CFCSymbol*)self);
-}
-
char*
CFCMethod_short_typedef(CFCMethod *self, CFCClass *invoker) {
return S_short_method_sym(self, invoker, "_t");
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCMethod.h
----------------------------------------------------------------------
diff --git a/compiler/src/CFCMethod.h b/compiler/src/CFCMethod.h
index dd39203..f6beb94 100644
--- a/compiler/src/CFCMethod.h
+++ b/compiler/src/CFCMethod.h
@@ -148,9 +148,6 @@ CFCMethod_full_offset_sym(CFCMethod *self, struct CFCClass *invoker);
const char*
CFCMethod_get_macro_sym(CFCMethod *self);
-const char*
-CFCMethod_micro_sym(CFCMethod *self);
-
/** Create the typedef symbol for this method, e.g "Claw_Pinch_t".
* @param invoker Class for which the symbol is created. If invoker is NULL,
* use the class where the method is defined.
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCPerlClass.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlClass.c b/compiler/src/CFCPerlClass.c
index db6edfc..ab8c846 100644
--- a/compiler/src/CFCPerlClass.c
+++ b/compiler/src/CFCPerlClass.c
@@ -270,12 +270,6 @@ CFCPerlClass_method_bindings(CFCClass *klass) {
continue;
}
- // See if the user wants the method to have a specific alias.
- const char *alias = CFCMethod_get_host_alias(method);
- if (!alias) {
- alias = CFCMethod_micro_sym(method);
- }
-
/* Create the binding, add it to the array.
*
* Also create an XSub binding for each override. Each of these
@@ -284,7 +278,7 @@ CFCPerlClass_method_bindings(CFCClass *klass) {
* this way allows SUPER:: invocations from Perl-space to work
* properly.
*/
- CFCPerlMethod *meth_binding = CFCPerlMethod_new(method, alias);
+ CFCPerlMethod *meth_binding = CFCPerlMethod_new(method);
size_t size = (num_bound + 2) * sizeof(CFCPerlMethod*);
bound = (CFCPerlMethod**)REALLOCATE(bound, size);
bound[num_bound] = meth_binding;
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCPerlMethod.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c
index 8027cb0..9f33065 100644
--- a/compiler/src/CFCPerlMethod.c
+++ b/compiler/src/CFCPerlMethod.c
@@ -16,6 +16,7 @@
#include <string.h>
#include <stdio.h>
+#include <ctype.h>
#define CFC_NEED_PERLSUB_STRUCT_DEF 1
#include "CFCPerlSub.h"
@@ -106,32 +107,24 @@ static const CFCMeta CFCPERLMETHOD_META = {
};
CFCPerlMethod*
-CFCPerlMethod_new(CFCMethod *method, const char *alias) {
+CFCPerlMethod_new(CFCMethod *method) {
CFCPerlMethod *self
= (CFCPerlMethod*)CFCBase_allocate(&CFCPERLMETHOD_META);
- return CFCPerlMethod_init(self, method, alias);
+ return CFCPerlMethod_init(self, method);
}
CFCPerlMethod*
-CFCPerlMethod_init(CFCPerlMethod *self, CFCMethod *method,
- const char *alias) {
+CFCPerlMethod_init(CFCPerlMethod *self, CFCMethod *method) {
CFCParamList *param_list = CFCMethod_get_param_list(method);
const char *class_name = CFCMethod_get_class_name(method);
int use_labeled_params = CFCParamList_num_vars(param_list) > 2
? 1 : 0;
- // The Clownfish destructor needs to be spelled DESTROY for Perl.
- if (!alias) {
- alias = CFCMethod_micro_sym(method);
- }
- static const char destroy_uppercase[] = "DESTROY";
- if (strcmp(alias, "destroy") == 0) {
- alias = destroy_uppercase;
- }
-
- CFCPerlSub_init((CFCPerlSub*)self, param_list, class_name, alias,
+ char *perl_name = CFCPerlMethod_perl_name(method);
+ CFCPerlSub_init((CFCPerlSub*)self, param_list, class_name, perl_name,
use_labeled_params);
self->method = (CFCMethod*)CFCBase_incref((CFCBase*)method);
+ FREEMEM(perl_name);
return self;
}
@@ -142,6 +135,32 @@ CFCPerlMethod_destroy(CFCPerlMethod *self) {
}
char*
+CFCPerlMethod_perl_name(CFCMethod *method) {
+ // See if the user wants the method to have a specific alias.
+ const char *alias = CFCMethod_get_host_alias(method);
+ if (alias) {
+ return CFCUtil_strdup(alias);
+ }
+
+ char *perl_name = NULL;
+ const char *name = CFCMethod_get_macro_sym(method);
+
+ if (strcmp(name, "Destroy") == 0) {
+ // The Clownfish destructor needs to be spelled DESTROY for Perl.
+ perl_name = CFCUtil_strdup("DESTROY");
+ }
+ else {
+ // Derive Perl name by lowercasing.
+ perl_name = CFCUtil_strdup(name);
+ for (size_t i = 0; perl_name[i] != '\0'; i++) {
+ perl_name[i] = tolower(perl_name[i]);
+ }
+ }
+
+ return perl_name;
+}
+
+char*
CFCPerlMethod_xsub_def(CFCPerlMethod *self) {
if (self->sub.use_labeled_params) {
return S_xsub_def_labeled_params(self);
@@ -632,7 +651,7 @@ S_void_callback_def(CFCMethod *method, const char *callback_start,
const char *refcount_mods) {
const char *override_sym = CFCMethod_full_override_sym(method);
const char *params = CFCParamList_to_c(CFCMethod_get_param_list(method));
- const char *micro_sym = CFCMethod_micro_sym(method);
+ char *perl_name = CFCPerlMethod_perl_name(method);
const char pattern[] =
"void\n"
"%s(%s) {\n"
@@ -641,8 +660,9 @@ S_void_callback_def(CFCMethod *method, const char *callback_start,
"}\n";
char *callback_def
= CFCUtil_sprintf(pattern, override_sym, params, callback_start,
- micro_sym, refcount_mods);
+ perl_name, refcount_mods);
+ FREEMEM(perl_name);
return callback_def;
}
@@ -653,7 +673,6 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start,
const char *params = CFCParamList_to_c(CFCMethod_get_param_list(method));
CFCType *return_type = CFCMethod_get_return_type(method);
const char *ret_type_str = CFCType_to_c(return_type);
- const char *micro_sym = CFCMethod_micro_sym(method);
char callback_func[50];
if (CFCType_is_integer(return_type)) {
@@ -671,6 +690,8 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start,
CFCUtil_die("Unexpected type: %s", ret_type_str);
}
+ char *perl_name = CFCPerlMethod_perl_name(method);
+
char pattern[] =
"%s\n"
"%s(%s) {\n"
@@ -681,8 +702,9 @@ S_primitive_callback_def(CFCMethod *method, const char *callback_start,
char *callback_def
= CFCUtil_sprintf(pattern, ret_type_str, override_sym, params,
callback_start, ret_type_str, ret_type_str,
- callback_func, micro_sym, refcount_mods);
+ callback_func, perl_name, refcount_mods);
+ FREEMEM(perl_name);
return callback_def;
}
@@ -693,9 +715,10 @@ S_obj_callback_def(CFCMethod *method, const char *callback_start,
const char *params = CFCParamList_to_c(CFCMethod_get_param_list(method));
CFCType *return_type = CFCMethod_get_return_type(method);
const char *ret_type_str = CFCType_to_c(return_type);
- const char *micro_sym = CFCMethod_micro_sym(method);
const char *nullable = CFCType_nullable(return_type) ? "true" : "false";
+ char *perl_name = CFCPerlMethod_perl_name(method);
+
char pattern[] =
"%s\n"
"%s(%s) {\n"
@@ -706,8 +729,9 @@ S_obj_callback_def(CFCMethod *method, const char *callback_start,
char *callback_def
= CFCUtil_sprintf(pattern, ret_type_str, override_sym, params,
callback_start, ret_type_str, ret_type_str,
- micro_sym, nullable, refcount_mods);
+ perl_name, nullable, refcount_mods);
+ FREEMEM(perl_name);
return callback_def;
}
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/0c2b1bce/compiler/src/CFCPerlMethod.h
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlMethod.h b/compiler/src/CFCPerlMethod.h
index dbd19c0..be441c4 100644
--- a/compiler/src/CFCPerlMethod.h
+++ b/compiler/src/CFCPerlMethod.h
@@ -35,20 +35,23 @@ typedef struct CFCPerlMethod CFCPerlMethod;
struct CFCMethod;
CFCPerlMethod*
-CFCPerlMethod_new(struct CFCMethod *method, const char *alias);
+CFCPerlMethod_new(struct CFCMethod *method);
/**
* @param method A Clownfish::CFC::Model::Method.
- * @param alias The perl name for the method. Defaults to the lowercased name
- * of the supplied Clownfish Method.
*/
CFCPerlMethod*
-CFCPerlMethod_init(CFCPerlMethod *self, struct CFCMethod *method,
- const char *alias);
+CFCPerlMethod_init(CFCPerlMethod *self, struct CFCMethod *method);
void
CFCPerlMethod_destroy(CFCPerlMethod *self);
+/**
+ * Create the Perl name of the method.
+ */
+char*
+CFCPerlMethod_perl_name(struct CFCMethod *method);
+
/** Generate C code for the XSUB.
*/
char*
[2/4] git commit: Cache novel method in CFCMethod
Posted by nw...@apache.org.
Cache novel method in CFCMethod
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/7744424b
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/7744424b
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/7744424b
Branch: refs/heads/master
Commit: 7744424b8fbc383fda910fc34c8def46e0b26c44
Parents: 811d2ef
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Sat Jul 26 20:20:00 2014 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Tue Jul 29 00:21:20 2014 +0200
----------------------------------------------------------------------
compiler/src/CFCClass.c | 15 ---------------
compiler/src/CFCClass.h | 6 ------
compiler/src/CFCMethod.c | 26 +++++++++++++++++++++++---
compiler/src/CFCMethod.h | 6 ++++++
compiler/src/CFCPerlClass.c | 16 ++--------------
5 files changed, 31 insertions(+), 38 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/7744424b/compiler/src/CFCClass.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCClass.c b/compiler/src/CFCClass.c
index e896818..7322e22 100644
--- a/compiler/src/CFCClass.c
+++ b/compiler/src/CFCClass.c
@@ -664,21 +664,6 @@ CFCClass_fresh_member_vars(CFCClass *self) {
return (CFCVariable**)S_fresh_syms(self, (CFCSymbol**)self->member_vars);
}
-CFCMethod*
-CFCClass_find_novel_method(CFCClass *self, const char *sym) {
- if (!self->tree_grown) {
- CFCUtil_die("Can't call original_method before grow_tree");
- }
- CFCClass *ancestor = self;
- do {
- CFCMethod *method = CFCClass_method(ancestor, sym);
- if (method && CFCMethod_novel(method)) {
- return method;
- }
- } while (NULL != (ancestor = CFCClass_get_parent(ancestor)));
- return NULL;
-}
-
CFCClass**
CFCClass_children(CFCClass *self) {
return self->children;
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/7744424b/compiler/src/CFCClass.h
----------------------------------------------------------------------
diff --git a/compiler/src/CFCClass.h b/compiler/src/CFCClass.h
index 9dde5b4..78eefd0 100644
--- a/compiler/src/CFCClass.h
+++ b/compiler/src/CFCClass.h
@@ -133,12 +133,6 @@ CFCClass_method(CFCClass *self, const char *sym);
struct CFCMethod*
CFCClass_fresh_method(CFCClass *self, const char *sym);
-/** Traverse all ancestors to find the first class which declared the method
- * and return it. Cannot be called before grow_tree().
- */
-struct CFCMethod*
-CFCClass_find_novel_method(CFCClass *self, const char *sym);
-
/** Find the actual class of all object variables without prefix.
*/
void
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/7744424b/compiler/src/CFCMethod.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCMethod.c b/compiler/src/CFCMethod.c
index 9335577..0c89f68 100644
--- a/compiler/src/CFCMethod.c
+++ b/compiler/src/CFCMethod.c
@@ -36,6 +36,7 @@
struct CFCMethod {
CFCFunction function;
+ CFCMethod *novel_method;
char *macro_sym;
char *full_override_sym;
char *host_alias;
@@ -127,6 +128,7 @@ CFCMethod_init(CFCMethod *self, CFCParcel *parcel, const char *exposure,
}
}
+ self->novel_method = NULL;
self->macro_sym = CFCUtil_strdup(macro_sym);
self->full_override_sym = NULL;
self->host_alias = NULL;
@@ -155,6 +157,7 @@ CFCMethod_resolve_types(CFCMethod *self) {
void
CFCMethod_destroy(CFCMethod *self) {
+ CFCBase_decref((CFCBase*)self->novel_method);
FREEMEM(self->macro_sym);
FREEMEM(self->full_override_sym);
FREEMEM(self->host_alias);
@@ -234,6 +237,10 @@ CFCMethod_override(CFCMethod *self, CFCMethod *orig) {
// Mark the Method as no longer novel.
self->is_novel = false;
+
+ // Cache novel method.
+ CFCMethod *novel_method = orig->is_novel ? orig : orig->novel_method;
+ self->novel_method = (CFCMethod*)CFCBase_incref((CFCBase*)novel_method);
}
CFCMethod*
@@ -248,7 +255,8 @@ CFCMethod_finalize(CFCMethod *self) {
self->function.param_list,
self->function.docucomment, true,
self->is_abstract);
- finalized->is_novel = self->is_novel;
+ finalized->novel_method = self->novel_method;
+ finalized->is_novel = self->is_novel;
return finalized;
}
@@ -272,7 +280,8 @@ CFCMethod_set_host_alias(CFCMethod *self, const char *alias) {
const char*
CFCMethod_get_host_alias(CFCMethod *self) {
- return self->host_alias;
+ CFCMethod *novel_method = CFCMethod_find_novel_method(self);
+ return novel_method->host_alias;
}
void
@@ -286,7 +295,18 @@ CFCMethod_exclude_from_host(CFCMethod *self) {
int
CFCMethod_excluded_from_host(CFCMethod *self) {
- return self->is_excluded;
+ CFCMethod *novel_method = CFCMethod_find_novel_method(self);
+ return novel_method->is_excluded;
+}
+
+CFCMethod*
+CFCMethod_find_novel_method(CFCMethod *self) {
+ if (self->is_novel) {
+ return self;
+ }
+ else {
+ return self->novel_method;
+ }
}
static char*
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/7744424b/compiler/src/CFCMethod.h
----------------------------------------------------------------------
diff --git a/compiler/src/CFCMethod.h b/compiler/src/CFCMethod.h
index 54d7e38..dd39203 100644
--- a/compiler/src/CFCMethod.h
+++ b/compiler/src/CFCMethod.h
@@ -108,6 +108,12 @@ CFCMethod*
CFCMethod_finalize(CFCMethod *self);
/**
+ * Find the first declaration of the method in the class hierarchy.
+ */
+CFCMethod*
+CFCMethod_find_novel_method(CFCMethod *self);
+
+/**
* Create the symbol used to invoke the method without the parcel Prefix, e.g.
* "LobClaw_Pinch".
* @param invoker Class for which the symbol is created. If invoker is NULL,
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/7744424b/compiler/src/CFCPerlClass.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlClass.c b/compiler/src/CFCPerlClass.c
index 9d52b16..db6edfc 100644
--- a/compiler/src/CFCPerlClass.c
+++ b/compiler/src/CFCPerlClass.c
@@ -258,20 +258,8 @@ CFCPerlClass_method_bindings(CFCClass *klass) {
// Skip private methods.
if (CFCSymbol_private((CFCSymbol*)method)) { continue; }
- CFCMethod *novel_method;
- if (CFCMethod_novel(method)) {
- novel_method = method;
- }
- else {
- const char *meth_name = CFCMethod_get_macro_sym(method);
- novel_method = CFCClass_find_novel_method(parent, meth_name);
- if (!novel_method) {
- CFCUtil_die("Novel method not found");
- }
- }
-
// Skip methods which have been explicitly excluded.
- if (CFCMethod_excluded_from_host(novel_method)) {
+ if (CFCMethod_excluded_from_host(method)) {
continue;
}
@@ -283,7 +271,7 @@ CFCPerlClass_method_bindings(CFCClass *klass) {
}
// See if the user wants the method to have a specific alias.
- const char *alias = CFCMethod_get_host_alias(novel_method);
+ const char *alias = CFCMethod_get_host_alias(method);
if (!alias) {
alias = CFCMethod_micro_sym(method);
}
[4/4] git commit: Define Perl alias for Destroy method via bindings
Posted by nw...@apache.org.
Define Perl alias for Destroy method via bindings
Now it should be possible to override the destructor from Perl.
Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo
Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/2981de38
Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/2981de38
Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/2981de38
Branch: refs/heads/master
Commit: 2981de38dc5848fe10d94d2898195d5f1083cb13
Parents: 64cf00e
Author: Nick Wellnhofer <we...@aevum.de>
Authored: Tue Jul 29 00:33:31 2014 +0200
Committer: Nick Wellnhofer <we...@aevum.de>
Committed: Thu Jul 31 12:49:08 2014 +0200
----------------------------------------------------------------------
compiler/src/CFCPerlMethod.c | 16 ++++------------
runtime/perl/buildlib/Clownfish/Build/Binding.pm | 4 ++++
2 files changed, 8 insertions(+), 12 deletions(-)
----------------------------------------------------------------------
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/2981de38/compiler/src/CFCPerlMethod.c
----------------------------------------------------------------------
diff --git a/compiler/src/CFCPerlMethod.c b/compiler/src/CFCPerlMethod.c
index 9f33065..20a82e6 100644
--- a/compiler/src/CFCPerlMethod.c
+++ b/compiler/src/CFCPerlMethod.c
@@ -142,19 +142,11 @@ CFCPerlMethod_perl_name(CFCMethod *method) {
return CFCUtil_strdup(alias);
}
- char *perl_name = NULL;
+ // Derive Perl name by lowercasing.
const char *name = CFCMethod_get_macro_sym(method);
-
- if (strcmp(name, "Destroy") == 0) {
- // The Clownfish destructor needs to be spelled DESTROY for Perl.
- perl_name = CFCUtil_strdup("DESTROY");
- }
- else {
- // Derive Perl name by lowercasing.
- perl_name = CFCUtil_strdup(name);
- for (size_t i = 0; perl_name[i] != '\0'; i++) {
- perl_name[i] = tolower(perl_name[i]);
- }
+ char *perl_name = CFCUtil_strdup(name);
+ for (size_t i = 0; perl_name[i] != '\0'; i++) {
+ perl_name[i] = tolower(perl_name[i]);
}
return perl_name;
http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/2981de38/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 fba3def..ccfaeca 100644
--- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm
+++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm
@@ -477,6 +477,10 @@ END_XS_CODE
parcel => "Clownfish",
class_name => "Clownfish::Obj",
);
+ $binding->bind_method(
+ alias => 'DESTROY',
+ method => 'Destroy',
+ );
$binding->exclude_method($_) for @hand_rolled;
$binding->append_xs($xs_code);
$binding->set_pod_spec($pod_spec);
[3/4] git commit: Fix overriding of aliased methods
Posted by nw...@apache.org.
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