Hi,
whats the plan WRT to CALL__BUILD?
I've written a patch that makes it the default, but does a fallback to
"__init" if no BUILD property is set. If the __init method does not exists,
no exception is thrown (like before), whereas now an exception is thrown if
you specify a BUILD property and the specified method does not exists.
A special case is if you set BUILD to an empty string, then no constructor is
called for the class, not even __init if it exists.
All tests are passing, plus two new tests for the new functionality (exception
if constructor not found and constructor disabling)
Should I apply it?
jens
Index: src/objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.90
diff -u -w -r1.90 objects.c
--- src/objects.c 27 Apr 2004 12:00:43 -0000 1.90
+++ src/objects.c 14 May 2004 15:09:34 -0000
@@ -482,6 +482,7 @@
void * __ptr;
} __ptr_u;
STRING *meth;
+ *meth_str = NULL;
#if 0
prop = VTABLE_getprop(interpreter, class, prop_str);
if (!VTABLE_defined(interpreter, prop))
@@ -509,6 +510,7 @@
PMC *classsearch_array = get_attrib_num(class_data, PCD_ALL_PARENTS);
PMC *parent_class;
INTVAL i, nparents;
+#if 0
int free_it;
static void *what = (void*)-1;
/*
@@ -527,6 +529,7 @@
Parrot_base_vtables[enum_class_delegate]->init(interpreter, object);
}
else {
+#endif
/*
* 1) if class has a CONSTRUCT property run it on the object
* no redispatch
@@ -538,6 +541,7 @@
STRING *meth_str;
PMC *meth = get_init_meth(interpreter, class,
CONST_STRING(interpreter, "CONSTRUCT"), &meth_str);
+ int default_meth;
if (meth) {
if (init)
Parrot_run_meth_fromc_args_save(interpreter, meth,
@@ -556,6 +560,16 @@
classsearch_array, i);
meth = get_init_meth(interpreter, parent_class,
CONST_STRING(interpreter, "BUILD"), &meth_str);
+ /* no method found and no BUILD property set? */
+ if (!meth && meth_str == NULL) {
+ /* use __init as fallback constructor method, if it exists */
+ meth_str = string_from_cstring(interpreter, "__init", 6);
+ meth = Parrot_find_method_with_cache(interpreter,
+ parent_class, meth_str);
+ default_meth = 1;
+ }
+ else
+ default_meth = 0;
if (meth) {
if (init)
Parrot_run_meth_fromc_args_save(interpreter, meth,
@@ -564,9 +578,23 @@
Parrot_run_meth_fromc_save(interpreter, meth,
object, meth_str);
}
+ else if (meth_str != NULL &&
+ string_length(interpreter, meth_str) != 0 && !default_meth) {
+ real_exception(interpreter, NULL, METH_NOT_FOUND,
+ "Method '%Ss' not found", meth_str);
+ }
}
meth = get_init_meth(interpreter, class,
CONST_STRING(interpreter, "BUILD"), &meth_str);
+ /* no method found and no BUILD property set? */
+ if (!meth && meth_str == NULL) {
+ /* use __init as fallback constructor method, if it exists */
+ meth_str = string_from_cstring(interpreter, "__init", 6);
+ meth = Parrot_find_method_with_cache(interpreter, class, meth_str);
+ default_meth = 1;
+ }
+ else
+ default_meth = 0;
if (meth) {
if (init)
Parrot_run_meth_fromc_args_save(interpreter, meth,
@@ -575,7 +603,14 @@
Parrot_run_meth_fromc_save(interpreter, meth,
object, meth_str);
}
+ else if (meth_str != NULL && string_length(interpreter, meth_str) != 0
+ && !default_meth) {
+ real_exception(interpreter, NULL, METH_NOT_FOUND,
+ "Method '%Ss' not found", meth_str);
}
+#if 0
+ }
+#endif
}
/*
Index: t/pmc/object-meths.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/object-meths.t,v
retrieving revision 1.17
diff -u -w -r1.17 object-meths.t
--- t/pmc/object-meths.t 10 Apr 2004 12:50:23 -0000 1.17
+++ t/pmc/object-meths.t 14 May 2004 15:09:35 -0000
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 19;
+use Parrot::Test tests => 21;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmethod - unknown method");
@@ -136,6 +136,52 @@
ok 2
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "disabling the constructor");
+ newclass P1, "Foo"
+ new P0, .PerlString
+ setprop P1, "BUILD", P0
+ find_type I1, "Foo"
+ new P3, I1
+ print "ok 1\n"
+ end
+.namespace ["Foo"]
+.pcc_sub __init:
+ print "nok ok!\n"
+ invoke P1
+CODE
+ok 1
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "specified constructor method does not exist");
+ newclass P1, "Foo"
+ new P0, .PerlString
+ set P0, "bar"
+ setprop P1, "BUILD", P0
+
+ newsub P20, .Exception_Handler, _handler
+ set_eh P20
+
+ find_type I1, "Foo"
+ new P3, I1
+ print "not ok 1\n"
+ end
+
+_handler:
+ print "catched it\n"
+ set S0, P5["_message"] # P5 is the exception object
+ print S0
+ print "\n"
+ end
+
+.namespace ["Foo"]
+.pcc_sub __init:
+ print "nok ok 2!\n"
+ invoke P1
+CODE
+catched it
+Method 'bar' not found
+OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "constructor - init attr");
newclass P1, "Foo"
addattribute P1, ".i"
@@ -604,8 +650,6 @@
OUTPUT
};
-$ENV{"CALL__BUILD"} = "1";
-
output_is(<<'CODE', <<'OUTPUT', "constructor - parents BUILD");
new P10, .PerlString
set P10, "_new"
@@ -658,8 +702,6 @@
in sub
done
OUTPUT
-
-delete $ENV{"CALL__BUILD"};
output_is(<<'CODE', <<'OUTPUT', "same method name in two namespaces");
##PIR##
