Peter N Lewis wrote:
Does GPC support telling whether an object is a member of a particular object class hierarchy?
Mac Pascals have
member( obj, ObjectType )
which returns a boolean, true if obj is an object of type ObjectType.
I've included a sample program below.
If GPC has an alternative way of telling this, that will probably solve my problem, although this may still be an issue for compatibility.
Thanks, Peter.
GPC uses `is' operator for this purpose. However, there are poblems: 1) `is' was disabled for Mac Pascal 2) `is' did not work for Mac objects (classes). Patch below add needed support. 3) after adding {$define member(a,b) (a is b)} to your program (and with the patch) I get:
peterU2.pas:36: warning: `is' always yields `True' if the right operand peterU2.pas:36: warning: is the declared type of the left operand. peterU2.pas:38: error: right operand of `is' must be a derived type peterU2.pas:38: error: of the declared type of the left operand peterU2.pas:38: warning: `is' always yields `True' if the right operand peterU2.pas:38: warning: is the declared type of the left operand. peterU2.pas:39: error: right operand of `is' must be a derived type peterU2.pas:39: error: of the declared type of the left operand peterU2.pas:40: error: right operand of `is' must be a derived type peterU2.pas:40: error: of the declared type of the left operand peterU2.pas:41: error: right operand of `is' must be a derived type peterU2.pas:41: error: of the declared type of the left operand peterU2.pas:41: warning: `is' always yields `True' if the right operand peterU2.pas:41: warning: is the declared type of the left operand.
In particular, GPC considers `a is ObjectB' as error if ObjectB is not a derived class of class of a. While we may add some support for useless tests of this sort, it seems better to give error by default
diff -u p.nn/objects.c p/objects.c --- p.nn/objects.c 2005-06-22 07:32:06.000000000 +0200 +++ p/objects.c 2005-07-02 15:22:38.514561976 +0200 @@ -705,6 +705,16 @@ build_is_as (tree left, tree right, int op) { const char *opname = (op == p_is) ? "is" : "as"; + int want_class = 0; + tree oleft = left; + if (TREE_CODE (right) == POINTER_TYPE && PASCAL_TYPE_CLASS (right)) + { + right = TREE_TYPE (right); + want_class = 1; + } + if (TREE_CODE (TREE_TYPE (left)) == POINTER_TYPE + && PASCAL_TYPE_CLASS (TREE_TYPE (left))) + left = build_indirect_ref (left, NULL); if (!PASCAL_TYPE_OBJECT (right)) error ("right operand of `%s' must be an object type", opname); else if (!PASCAL_TYPE_OBJECT (TREE_TYPE (left))) @@ -718,7 +728,11 @@ || TREE_CODE (l) == NON_LVALUE_EXPR) l = TREE_OPERAND (l, 0); while (t && TYPE_MAIN_VARIANT (t) != tl) - t = TYPE_LANG_BASE (t); + { + t = TYPE_LANG_BASE (t); + if (t && TREE_CODE (t) == POINTER_TYPE) + t = TREE_TYPE (t); + } if (!t) { error ("right operand of `%s' must be a derived type", opname); @@ -738,7 +752,7 @@ { warning ("`as' has no effect if the right operand is"); warning (" the declared type of the left operand"); - return left; + return oleft; } } /* Variables, value parameters and components are not polymorphic. @@ -784,12 +798,13 @@ within the RTS so the compiler can optimize a construction like `if foo is bar then something (foo as bar)'. */ p_right = build_pointer_type (right); - return build_indirect_ref (save_expr ( + res = save_expr ( build (COMPOUND_EXPR, p_right, build (COND_EXPR, void_type_node, res, convert (void_type_node, integer_zero_node), build_predef_call (p_as, NULL_TREE)), - convert (p_right, build_pascal_unary_op (ADDR_EXPR, left)))), NULL); + convert (p_right, build_pascal_unary_op (ADDR_EXPR, left)))); + return want_class ? res : build_indirect_ref (res, NULL); } } } diff -u p.nn/predef.def p/predef.def --- p.nn/predef.def 2005-06-22 03:59:53.000000000 +0200 +++ p/predef.def 2005-07-02 14:29:45.660909048 +0200 @@ -57,7 +57,7 @@ PREDEF_KEYWORD (and, 0, ANY_PASCAL) /* Boolean or bitwise `and' operator or part of the <and then> operator */ PREDEF_KEYWORD (and_then, 1, E_O_PASCAL) /* short-circuit Boolean <and> operator */ PREDEF_KEYWORD (array, 0, ANY_PASCAL) /* array type declaration */ -PREDEF_KEYWORD (as, 1, O_D_PASCAL) /* object type membership test and conversion */ +PREDEF_KEYWORD (as, 1, O_D_M_PASCAL) /* object type membership test and conversion */ PREDEF_KEYWORD (asm, 1, B_D_PASCAL) /* GNU style inline assembler code */ PREDEF_KEYWORD (asmname, 1, GNU_PASCAL) /* DEPRECATED! linker name of routines and variables */ PREDEF_KEYWORD (attribute, 1, GNU_PASCAL) /* attributes of routines and variables */ @@ -89,7 +89,7 @@ PREDEF_KEYWORD (in, 0, ANY_PASCAL) /* set membership test or part of a <for> loop iterating through sets */ PREDEF_KEYWORD (inherited, 1, O_B_D_M_PASCAL) /* reference to methods of ancestor object types */ PREDEF_KEYWORD (initialization, 1, BORLAND_DELPHI) /* unit initialization */ -PREDEF_KEYWORD (is, 1, O_D_PASCAL) /* object type membership test */ +PREDEF_KEYWORD (is, 1, O_D_M_PASCAL) /* object type membership test */ PREDEF_KEYWORD (label, 0, ANY_PASCAL) /* label declaration for a <goto> statement */ PREDEF_KEYWORD (mod, 0, ANY_PASCAL) /* integer remainder operator */ PREDEF_KEYWORD (near, 0, B_D_PASCAL) /* BP directive (ignored) */