Repository: lucy-clownfish Updated Branches: refs/heads/master 3764af037 -> 06334f303
Make Obj_Get_Class inert Project: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/repo Commit: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/commit/303da5fe Tree: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/tree/303da5fe Diff: http://git-wip-us.apache.org/repos/asf/lucy-clownfish/diff/303da5fe Branch: refs/heads/master Commit: 303da5fe9392bd41cc87698787ec782116aa0731 Parents: 3764af0 Author: Nick Wellnhofer <[email protected]> Authored: Wed May 27 17:23:59 2015 +0200 Committer: Nick Wellnhofer <[email protected]> Committed: Thu May 28 17:43:20 2015 +0200 ---------------------------------------------------------------------- compiler/src/CFCBindClass.c | 53 +++++++++++++++++++- runtime/core/Clownfish/Obj.c | 2 +- runtime/core/Clownfish/Obj.cfh | 4 +- runtime/core/Clownfish/Test/TestObj.c | 4 +- .../perl/buildlib/Clownfish/Build/Binding.pm | 8 +++ runtime/perl/t/binding/019-obj.t | 10 +++- 6 files changed, 73 insertions(+), 8 deletions(-) ---------------------------------------------------------------------- http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/303da5fe/compiler/src/CFCBindClass.c ---------------------------------------------------------------------- diff --git a/compiler/src/CFCBindClass.c b/compiler/src/CFCBindClass.c index a30ea18..3033a81 100644 --- a/compiler/src/CFCBindClass.c +++ b/compiler/src/CFCBindClass.c @@ -70,6 +70,10 @@ S_sub_declarations(CFCBindClass *self); static char* S_inert_var_declarations(CFCBindClass *self); +// Define type-safe wrappers for Obj functions. +static char* +S_wrapper_defs(CFCBindClass *self); + // Define method invocation inline functions. static char* S_method_defs(CFCBindClass *self); @@ -198,6 +202,7 @@ S_to_c_header_dynamic(CFCBindClass *self) { char *sub_declarations = S_sub_declarations(self); char *inert_var_defs = S_inert_var_declarations(self); char *method_typedefs = S_method_typedefs(self); + char *wrapper_defs = S_wrapper_defs(self); char *method_defs = S_method_defs(self); char *override_decs = S_override_decs(self); char *short_names = S_short_names(self); @@ -233,6 +238,11 @@ S_to_c_header_dynamic(CFCBindClass *self) { "\n" "%s\n" "\n" + "/* Define type-safe wrappers for inert functions of Obj.\n" + " */\n" + "\n" + "%s\n" + "\n" "/* Define the inline functions which implement this class's virtual methods.\n" " */\n" "\n" @@ -251,8 +261,8 @@ S_to_c_header_dynamic(CFCBindClass *self) { char *content = CFCUtil_sprintf(pattern, parent_include, privacy_symbol, ivars, struct_def, privacy_symbol, inert_var_defs, - sub_declarations, method_typedefs, method_defs, - override_decs, short_names); + sub_declarations, method_typedefs, wrapper_defs, + method_defs, override_decs, short_names); FREEMEM(ivars); FREEMEM(struct_def); @@ -637,6 +647,28 @@ S_inert_var_declarations(CFCBindClass *self) { return declarations; } +// Define type-safe wrappers for Obj functions. +static char* +S_wrapper_defs(CFCBindClass *self) { + CFCClass *client = self->client; + + if (strcmp(CFCClass_get_name(client), "Clownfish::Obj") == 0) { + return CFCUtil_strdup(""); + } + + const char *prefix = CFCClass_get_prefix(client); + const char *nickname = CFCClass_get_nickname(client); + const char *struct_sym = CFCClass_full_struct_sym(client); + + const char *pattern = + "static CFISH_INLINE cfish_Class*\n" + "%s%s_get_class(%s *self) {\n" + " return cfish_Obj_get_class((cfish_Obj*)self);\n" + "}\n"; + + return CFCUtil_sprintf(pattern, prefix, nickname, struct_sym); +} + // Define method invocation inline functions. static char* S_method_defs(CFCBindClass *self) { @@ -734,6 +766,23 @@ S_short_names(CFCBindClass *self) { FREEMEM(full_sym); } + // Wrappers. + if (strcmp(CFCClass_get_name(client), "Clownfish::Obj") != 0) { + static const char *wrapped_funcs[] = { + "get_class" + }; + static int num_wrapped_funcs + = sizeof(wrapped_funcs) / sizeof(wrapped_funcs[0]); + const char *prefix = CFCClass_get_prefix(client); + const char *nickname = CFCClass_get_nickname(client); + for (int i = 0; i < num_wrapped_funcs; i++) { + const char *func = wrapped_funcs[i]; + short_names + = CFCUtil_cat(short_names, " #define ", nickname, "_", func, + " ", prefix, nickname, "_", func, "\n", NULL); + } + } + if (!CFCClass_inert(client)) { CFCMethod **fresh_methods = CFCClass_fresh_methods(client); for (int i = 0; fresh_methods[i] != NULL; i++) { http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/303da5fe/runtime/core/Clownfish/Obj.c ---------------------------------------------------------------------- diff --git a/runtime/core/Clownfish/Obj.c b/runtime/core/Clownfish/Obj.c index 6e99077..d10d7d8 100644 --- a/runtime/core/Clownfish/Obj.c +++ b/runtime/core/Clownfish/Obj.c @@ -78,7 +78,7 @@ Obj_To_String_IMP(Obj *self) { } Class* -Obj_Get_Class_IMP(Obj *self) { +Obj_get_class(Obj *self) { return self->klass; } http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/303da5fe/runtime/core/Clownfish/Obj.cfh ---------------------------------------------------------------------- diff --git a/runtime/core/Clownfish/Obj.cfh b/runtime/core/Clownfish/Obj.cfh index d4d20ad..b9d9fd4 100644 --- a/runtime/core/Clownfish/Obj.cfh +++ b/runtime/core/Clownfish/Obj.cfh @@ -65,8 +65,8 @@ public abstract class Clownfish::Obj { /** Return the object's Class. */ - public Class* - Get_Class(Obj *self); + public inert Class* + get_class(Obj *self); /** Return the name of the class that the object belongs to. */ http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/303da5fe/runtime/core/Clownfish/Test/TestObj.c ---------------------------------------------------------------------- diff --git a/runtime/core/Clownfish/Test/TestObj.c b/runtime/core/Clownfish/Test/TestObj.c index d763988..cb3fa14 100644 --- a/runtime/core/Clownfish/Test/TestObj.c +++ b/runtime/core/Clownfish/Test/TestObj.c @@ -88,12 +88,12 @@ test_Equals(TestBatchRunner *runner) { static void test_Is_A(TestBatchRunner *runner) { String *string = Str_new_from_trusted_utf8("", 0); - Class *str_class = Str_Get_Class(string); + Class *str_class = Str_get_class(string); String *class_name = Str_Get_Class_Name(string); TEST_TRUE(runner, Str_Is_A(string, STRING), "String Is_A String."); TEST_TRUE(runner, Str_Is_A(string, OBJ), "String Is_A Obj."); - TEST_TRUE(runner, str_class == STRING, "Get_Class"); + TEST_TRUE(runner, str_class == STRING, "get_class"); TEST_TRUE(runner, Str_Equals(Class_Get_Name(STRING), (Obj*)class_name), "Get_Class_Name"); http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/303da5fe/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 07ad5bd..14805bd 100644 --- a/runtime/perl/buildlib/Clownfish/Build/Binding.pm +++ b/runtime/perl/buildlib/Clownfish/Build/Binding.pm @@ -486,6 +486,14 @@ END_DESCRIPTION my $xs_code = <<'END_XS_CODE'; MODULE = Clownfish PACKAGE = Clownfish::Obj +SV* +get_class(self) + cfish_Obj *self +CODE: + cfish_Class *klass = cfish_Obj_get_class(self); + RETVAL = (SV*)CFISH_Class_To_Host(klass); +OUTPUT: RETVAL + bool is_a(self, class_name) cfish_Obj *self; http://git-wip-us.apache.org/repos/asf/lucy-clownfish/blob/303da5fe/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 5ac44e8..93ad0e8 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 => 21; +use Test::More tests => 24; package TestObj; use base qw( Clownfish::Obj ); @@ -85,6 +85,14 @@ eval { thaw($frozen) }; like( $@, qr/implement/, "thawing an Obj throws an exception rather than segfaults" ); +my $obj_class = $object->get_class; +isa_ok( $obj_class, "Clownfish::Class", + "get_class returns a Clownfish::Class" ); +my $testobj_class = Clownfish::Class->fetch_class('TestObj'); +isa_ok( $testobj_class, "Clownfish::Class", + "fetch_class returns a Clownfish::Class" ); +is( $$obj_class, $$testobj_class, "get_class returns correct class" ); + ok( $object->is_a("Clownfish::Obj"), "custom is_a correct" ); ok( !$object->is_a("Clownfish::Object"), "custom is_a too long" ); ok( !$object->is_a("Clownfish"), "custom is_a substring" );
