|
|
@@ -54,8 +54,7 @@ implementation
|
|
|
var
|
|
|
there_is_a_destructor : boolean;
|
|
|
classtype : tobjectdeftype;
|
|
|
- childof : tobjectdef;
|
|
|
- aktclass : tobjectdef;
|
|
|
+// childof : tobjectdef;
|
|
|
|
|
|
function constructor_head:tprocdef;
|
|
|
var
|
|
|
@@ -63,7 +62,7 @@ implementation
|
|
|
begin
|
|
|
consume(_CONSTRUCTOR);
|
|
|
{ must be at same level as in implementation }
|
|
|
- parse_proc_head(aktclass,potype_constructor,pd);
|
|
|
+ parse_proc_head(aktobjectdef,potype_constructor,pd);
|
|
|
if not assigned(pd) then
|
|
|
begin
|
|
|
consume(_SEMICOLON);
|
|
|
@@ -73,7 +72,7 @@ implementation
|
|
|
(pd.procsym.name<>'INIT') then
|
|
|
Message(parser_e_constructorname_must_be_init);
|
|
|
consume(_SEMICOLON);
|
|
|
- include(aktclass.objectoptions,oo_has_constructor);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_constructor);
|
|
|
{ Set return type, class constructors return the
|
|
|
created instance, object constructors return boolean }
|
|
|
if is_class(pd._class) then
|
|
|
@@ -89,17 +88,17 @@ implementation
|
|
|
p : tpropertysym;
|
|
|
begin
|
|
|
{ check for a class }
|
|
|
- if not((is_class_or_interface(aktclass)) or
|
|
|
- (not(m_tp7 in aktmodeswitches) and (is_object(aktclass)))) then
|
|
|
+ if not((is_class_or_interface(aktobjectdef)) or
|
|
|
+ (not(m_tp7 in aktmodeswitches) and (is_object(aktobjectdef)))) then
|
|
|
Message(parser_e_syntax_error);
|
|
|
consume(_PROPERTY);
|
|
|
- p:=read_property_dec(aktclass);
|
|
|
+ p:=read_property_dec(aktobjectdef);
|
|
|
consume(_SEMICOLON);
|
|
|
if try_to_consume(_DEFAULT) then
|
|
|
begin
|
|
|
- if oo_has_default_property in aktclass.objectoptions then
|
|
|
+ if oo_has_default_property in aktobjectdef.objectoptions then
|
|
|
message(parser_e_only_one_default_property);
|
|
|
- include(aktclass.objectoptions,oo_has_default_property);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_default_property);
|
|
|
include(p.propoptions,ppo_defaultproperty);
|
|
|
if not(ppo_hasparameters in p.propoptions) then
|
|
|
message(parser_e_property_need_paras);
|
|
|
@@ -117,7 +116,7 @@ implementation
|
|
|
pd : tprocdef;
|
|
|
begin
|
|
|
consume(_DESTRUCTOR);
|
|
|
- parse_proc_head(aktclass,potype_destructor,pd);
|
|
|
+ parse_proc_head(aktobjectdef,potype_destructor,pd);
|
|
|
if not assigned(pd) then
|
|
|
begin
|
|
|
consume(_SEMICOLON);
|
|
|
@@ -130,7 +129,7 @@ implementation
|
|
|
(m_fpc in aktmodeswitches) then
|
|
|
Message(parser_e_no_paras_for_destructor);
|
|
|
consume(_SEMICOLON);
|
|
|
- include(aktclass.objectoptions,oo_has_destructor);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_destructor);
|
|
|
{ no return value }
|
|
|
pd.rettype:=voidtype;
|
|
|
destructor_head:=pd;
|
|
|
@@ -149,44 +148,18 @@ implementation
|
|
|
{ publishable }
|
|
|
if classtype in [odt_interfacecom,odt_class] then
|
|
|
begin
|
|
|
- aktclass.objecttype:=classtype;
|
|
|
+ aktobjectdef.objecttype:=classtype;
|
|
|
if (cs_generate_rtti in aktlocalswitches) or
|
|
|
- (assigned(aktclass.childof) and
|
|
|
- (oo_can_have_published in aktclass.childof.objectoptions)) then
|
|
|
+ (assigned(aktobjectdef.childof) and
|
|
|
+ (oo_can_have_published in aktobjectdef.childof.objectoptions)) then
|
|
|
begin
|
|
|
- include(aktclass.objectoptions,oo_can_have_published);
|
|
|
+ include(aktobjectdef.objectoptions,oo_can_have_published);
|
|
|
{ in "publishable" classes the default access type is published }
|
|
|
current_object_option:=[sp_published];
|
|
|
end;
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
- procedure setclassparent;
|
|
|
-
|
|
|
- begin
|
|
|
- if assigned(fd) then
|
|
|
- aktclass:=fd
|
|
|
- else
|
|
|
- aktclass:=tobjectdef.create(classtype,n,nil);
|
|
|
- { is the current class tobject? }
|
|
|
- { so you could define your own tobject }
|
|
|
- if (cs_compilesystem in aktmoduleswitches) and (classtype=odt_class) and (upper(n)='TOBJECT') then
|
|
|
- class_tobject:=aktclass
|
|
|
- else if (cs_compilesystem in aktmoduleswitches) and (classtype=odt_interfacecom) and (upper(n)='IUNKNOWN') then
|
|
|
- interface_iunknown:=aktclass
|
|
|
- else
|
|
|
- begin
|
|
|
- case classtype of
|
|
|
- odt_class:
|
|
|
- childof:=class_tobject;
|
|
|
- odt_interfacecom:
|
|
|
- childof:=interface_iunknown;
|
|
|
- end;
|
|
|
- if (oo_is_forward in childof.objectoptions) then
|
|
|
- Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
|
|
|
- aktclass.set_parent(childof);
|
|
|
- end;
|
|
|
- end;
|
|
|
|
|
|
procedure setinterfacemethodoptions;
|
|
|
|
|
|
@@ -195,15 +168,15 @@ implementation
|
|
|
defs: TIndexArray;
|
|
|
pd: tdef;
|
|
|
begin
|
|
|
- include(aktclass.objectoptions,oo_has_virtual);
|
|
|
- defs:=aktclass.symtable.defindex;
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_virtual);
|
|
|
+ defs:=aktobjectdef.symtable.defindex;
|
|
|
for i:=1 to defs.count do
|
|
|
begin
|
|
|
pd:=tdef(defs.search(i));
|
|
|
if pd.deftype=procdef then
|
|
|
begin
|
|
|
- tprocdef(pd).extnumber:=aktclass.lastvtableindex;
|
|
|
- inc(aktclass.lastvtableindex);
|
|
|
+ tprocdef(pd).extnumber:=aktobjectdef.lastvtableindex;
|
|
|
+ inc(aktobjectdef.lastvtableindex);
|
|
|
include(tprocdef(pd).procoptions,po_virtualmethod);
|
|
|
tprocdef(pd).forwarddef:=false;
|
|
|
end;
|
|
|
@@ -240,9 +213,9 @@ implementation
|
|
|
{ also anonym objects aren't allow (o : object a : longint; end;) }
|
|
|
if n='' then
|
|
|
Message(parser_f_no_anonym_objects);
|
|
|
- aktclass:=tobjectdef.create(classtype,n,nil);
|
|
|
- include(aktclass.objectoptions,oo_is_forward);
|
|
|
- object_dec:=aktclass;
|
|
|
+ aktobjectdef:=tobjectdef.create(classtype,n,nil);
|
|
|
+ include(aktobjectdef.objectoptions,oo_is_forward);
|
|
|
+ object_dec:=aktobjectdef;
|
|
|
typecanbeforward:=storetypecanbeforward;
|
|
|
readobjecttype:=false;
|
|
|
exit;
|
|
|
@@ -265,12 +238,12 @@ implementation
|
|
|
{ also anonym objects aren't allow (o : object a : longint; end;) }
|
|
|
if n='' then
|
|
|
Message(parser_f_no_anonym_objects);
|
|
|
- aktclass:=tobjectdef.create(classtype,n,nil);
|
|
|
+ aktobjectdef:=tobjectdef.create(classtype,n,nil);
|
|
|
if (cs_compilesystem in aktmoduleswitches) and
|
|
|
(classtype=odt_interfacecom) and (upper(n)='IUNKNOWN') then
|
|
|
- interface_iunknown:=aktclass;
|
|
|
- include(aktclass.objectoptions,oo_is_forward);
|
|
|
- object_dec:=aktclass;
|
|
|
+ interface_iunknown:=aktobjectdef;
|
|
|
+ include(aktobjectdef.objectoptions,oo_is_forward);
|
|
|
+ object_dec:=aktobjectdef;
|
|
|
typecanbeforward:=storetypecanbeforward;
|
|
|
readobjecttype:=false;
|
|
|
exit;
|
|
|
@@ -316,16 +289,16 @@ implementation
|
|
|
{ also anonym objects aren't allow (o : object a : longint; end;) }
|
|
|
if n='' then
|
|
|
Message(parser_f_no_anonym_objects);
|
|
|
- aktclass:=tobjectdef.create(odt_class,n,nil);
|
|
|
+ aktobjectdef:=tobjectdef.create(odt_class,n,nil);
|
|
|
if (cs_compilesystem in aktmoduleswitches) and (upper(n)='TOBJECT') then
|
|
|
- class_tobject:=aktclass;
|
|
|
- aktclass.objecttype:=odt_class;
|
|
|
- include(aktclass.objectoptions,oo_is_forward);
|
|
|
+ class_tobject:=aktobjectdef;
|
|
|
+ aktobjectdef.objecttype:=odt_class;
|
|
|
+ include(aktobjectdef.objectoptions,oo_is_forward);
|
|
|
{ all classes must have a vmt !! at offset zero }
|
|
|
- if not(oo_has_vmt in aktclass.objectoptions) then
|
|
|
- aktclass.insertvmt;
|
|
|
+ if not(oo_has_vmt in aktobjectdef.objectoptions) then
|
|
|
+ aktobjectdef.insertvmt;
|
|
|
|
|
|
- object_dec:=aktclass;
|
|
|
+ object_dec:=aktobjectdef;
|
|
|
typecanbeforward:=storetypecanbeforward;
|
|
|
readobjecttype:=false;
|
|
|
exit;
|
|
|
@@ -347,16 +320,16 @@ implementation
|
|
|
Message1(type_e_interface_type_expected,implintf.typename);
|
|
|
exit;
|
|
|
end;
|
|
|
- if aktclass.implementedinterfaces.searchintf(implintf)<>-1 then
|
|
|
+ if aktobjectdef.implementedinterfaces.searchintf(implintf)<>-1 then
|
|
|
Message1(sym_e_duplicate_id,implintf.name)
|
|
|
else
|
|
|
begin
|
|
|
{ allocate and prepare the GUID only if the class
|
|
|
implements some interfaces.
|
|
|
}
|
|
|
- if aktclass.implementedinterfaces.count = 0 then
|
|
|
- aktclass.prepareguid;
|
|
|
- aktclass.implementedinterfaces.addintf(implintf);
|
|
|
+ if aktobjectdef.implementedinterfaces.count = 0 then
|
|
|
+ aktobjectdef.prepareguid;
|
|
|
+ aktobjectdef.implementedinterfaces.addintf(implintf);
|
|
|
end;
|
|
|
end;
|
|
|
|
|
|
@@ -384,11 +357,11 @@ implementation
|
|
|
p:=comp_expr(true);
|
|
|
if p.nodetype=stringconstn then
|
|
|
begin
|
|
|
- stringdispose(aktclass.iidstr);
|
|
|
- aktclass.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
|
|
|
+ stringdispose(aktobjectdef.iidstr);
|
|
|
+ aktobjectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); { or upper? }
|
|
|
p.free;
|
|
|
- valid:=string2guid(aktclass.iidstr^,aktclass.iidguid^);
|
|
|
- if (classtype=odt_interfacecom) and not assigned(aktclass.iidguid) and not valid then
|
|
|
+ valid:=string2guid(aktobjectdef.iidstr^,aktobjectdef.iidguid^);
|
|
|
+ if (classtype=odt_interfacecom) and not assigned(aktobjectdef.iidguid) and not valid then
|
|
|
Message(parser_e_improper_guid_syntax);
|
|
|
end
|
|
|
else
|
|
|
@@ -401,92 +374,110 @@ implementation
|
|
|
|
|
|
procedure readparentclasses;
|
|
|
var
|
|
|
- hp : tobjectdef;
|
|
|
+ intfchildof,
|
|
|
+ childof : tobjectdef;
|
|
|
+ tt : ttype;
|
|
|
+ hasparentdefined : boolean;
|
|
|
begin
|
|
|
- hp:=nil;
|
|
|
- { reads the parent class }
|
|
|
- if try_to_consume(_LKLAMMER) then
|
|
|
- begin
|
|
|
- id_type(tt,false);
|
|
|
- childof:=tobjectdef(tt.def);
|
|
|
- if (not assigned(childof)) or
|
|
|
- (childof.deftype<>objectdef) then
|
|
|
- begin
|
|
|
- if assigned(childof) then
|
|
|
- Message1(type_e_class_type_expected,childof.typename);
|
|
|
- childof:=nil;
|
|
|
- aktclass:=tobjectdef.create(classtype,n,nil);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { a mix of class, interfaces, objects and cppclasses
|
|
|
- isn't allowed }
|
|
|
- case classtype of
|
|
|
- odt_class:
|
|
|
- if not(is_class(childof)) then
|
|
|
- begin
|
|
|
- if is_interface(childof) then
|
|
|
- begin
|
|
|
- { we insert the interface after the child
|
|
|
- is set, see below
|
|
|
- }
|
|
|
- hp:=childof;
|
|
|
- childof:=class_tobject;
|
|
|
- end
|
|
|
- else
|
|
|
- Message(parser_e_mix_of_classes_and_objects);
|
|
|
- end;
|
|
|
- odt_interfacecorba,
|
|
|
- odt_interfacecom:
|
|
|
- if not(is_interface(childof)) then
|
|
|
- Message(parser_e_mix_of_classes_and_objects);
|
|
|
- odt_cppclass:
|
|
|
- if not(is_cppclass(childof)) then
|
|
|
- Message(parser_e_mix_of_classes_and_objects);
|
|
|
- odt_object:
|
|
|
- if not(is_object(childof)) then
|
|
|
- Message(parser_e_mix_of_classes_and_objects);
|
|
|
- odt_dispinterface:
|
|
|
- Message(parser_e_dispinterface_cant_have_parent);
|
|
|
- end;
|
|
|
- { the forward of the child must be resolved to get
|
|
|
- correct field addresses }
|
|
|
- if assigned(fd) then
|
|
|
- begin
|
|
|
- if (oo_is_forward in childof.objectoptions) then
|
|
|
- Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
|
|
|
- aktclass:=fd;
|
|
|
- { we must inherit several options !!
|
|
|
- this was missing !!
|
|
|
- all is now done in set_parent
|
|
|
- including symtable datasize setting PM }
|
|
|
- fd.set_parent(childof);
|
|
|
- end
|
|
|
- else
|
|
|
- aktclass:=tobjectdef.create(classtype,n,childof);
|
|
|
- if aktclass.objecttype=odt_class then
|
|
|
- begin
|
|
|
- if assigned(hp) then
|
|
|
- handleimplementedinterface(hp);
|
|
|
- readimplementedinterfaces;
|
|
|
- end;
|
|
|
- end;
|
|
|
- consume(_RKLAMMER);
|
|
|
- end
|
|
|
- { if no parent class, then a class get tobject as parent }
|
|
|
- else if classtype in [odt_class,odt_interfacecom] then
|
|
|
- setclassparent
|
|
|
- else
|
|
|
- aktclass:=tobjectdef.create(classtype,n,nil);
|
|
|
- { read GUID }
|
|
|
- if (classtype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and
|
|
|
- try_to_consume(_LECKKLAMMER) then
|
|
|
- begin
|
|
|
- readinterfaceiid;
|
|
|
- consume(_RECKKLAMMER);
|
|
|
- end
|
|
|
- else if (classtype=odt_dispinterface) then
|
|
|
- message(parser_e_dispinterface_needs_a_guid);
|
|
|
+ childof:=nil;
|
|
|
+ intfchildof:=nil;
|
|
|
+ hasparentdefined:=false;
|
|
|
+
|
|
|
+ { reads the parent class }
|
|
|
+ if try_to_consume(_LKLAMMER) then
|
|
|
+ begin
|
|
|
+ id_type(tt,false);
|
|
|
+ if (not assigned(tt.def)) or
|
|
|
+ (tt.def.deftype<>objectdef) then
|
|
|
+ begin
|
|
|
+ if assigned(tt.def) then
|
|
|
+ Message1(type_e_class_type_expected,childof.typename);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ childof:=tobjectdef(tt.def);
|
|
|
+ { a mix of class, interfaces, objects and cppclasses
|
|
|
+ isn't allowed }
|
|
|
+ case classtype of
|
|
|
+ odt_class:
|
|
|
+ if not(is_class(childof)) then
|
|
|
+ begin
|
|
|
+ if is_interface(childof) then
|
|
|
+ begin
|
|
|
+ { we insert the interface after the child
|
|
|
+ is set, see below
|
|
|
+ }
|
|
|
+ intfchildof:=childof;
|
|
|
+ childof:=class_tobject;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ Message(parser_e_mix_of_classes_and_objects);
|
|
|
+ end;
|
|
|
+ odt_interfacecorba,
|
|
|
+ odt_interfacecom:
|
|
|
+ if not(is_interface(childof)) then
|
|
|
+ Message(parser_e_mix_of_classes_and_objects);
|
|
|
+ odt_cppclass:
|
|
|
+ if not(is_cppclass(childof)) then
|
|
|
+ Message(parser_e_mix_of_classes_and_objects);
|
|
|
+ odt_object:
|
|
|
+ if not(is_object(childof)) then
|
|
|
+ Message(parser_e_mix_of_classes_and_objects);
|
|
|
+ odt_dispinterface:
|
|
|
+ Message(parser_e_dispinterface_cant_have_parent);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ hasparentdefined:=true;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { if no parent class, then a class get tobject as parent }
|
|
|
+ if not assigned(childof) then
|
|
|
+ begin
|
|
|
+ case classtype of
|
|
|
+ odt_class:
|
|
|
+ if aktobjectdef<>class_tobject then
|
|
|
+ childof:=class_tobject;
|
|
|
+ odt_interfacecom:
|
|
|
+ if aktobjectdef<>interface_iunknown then
|
|
|
+ childof:=interface_iunknown;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+
|
|
|
+ if assigned(childof) then
|
|
|
+ begin
|
|
|
+ { Forbid not completly defined objects to be used as parents. This will
|
|
|
+ also prevent circular loops of classes, because we set the forward flag
|
|
|
+ at the start of the new definition and will reset it below after the
|
|
|
+ parent has been set }
|
|
|
+ if not(oo_is_forward in childof.objectoptions) then
|
|
|
+ aktobjectdef.set_parent(childof)
|
|
|
+ else
|
|
|
+ Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^);
|
|
|
+ end;
|
|
|
+
|
|
|
+ { remove forward flag, is resolved }
|
|
|
+ exclude(aktobjectdef.objectoptions,oo_is_forward);
|
|
|
+
|
|
|
+ if hasparentdefined then
|
|
|
+ begin
|
|
|
+ if aktobjectdef.objecttype=odt_class then
|
|
|
+ begin
|
|
|
+ if assigned(intfchildof) then
|
|
|
+ handleimplementedinterface(intfchildof);
|
|
|
+ readimplementedinterfaces;
|
|
|
+ end;
|
|
|
+ consume(_RKLAMMER);
|
|
|
+ end;
|
|
|
+
|
|
|
+ { read GUID }
|
|
|
+ if (classtype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and
|
|
|
+ try_to_consume(_LECKKLAMMER) then
|
|
|
+ begin
|
|
|
+ readinterfaceiid;
|
|
|
+ consume(_RECKKLAMMER);
|
|
|
+ end
|
|
|
+ else if (classtype=odt_dispinterface) then
|
|
|
+ message(parser_e_dispinterface_needs_a_guid);
|
|
|
end;
|
|
|
|
|
|
procedure chkcpp(pd:tprocdef);
|
|
|
@@ -504,10 +495,6 @@ implementation
|
|
|
begin
|
|
|
old_object_option:=current_object_option;
|
|
|
|
|
|
- { forward is resolved }
|
|
|
- if assigned(fd) then
|
|
|
- exclude(fd.objectoptions,oo_is_forward);
|
|
|
-
|
|
|
{ objects and class types can't be declared local }
|
|
|
if not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) then
|
|
|
Message(parser_e_no_local_objects);
|
|
|
@@ -520,13 +507,35 @@ implementation
|
|
|
if not(readobjecttype) then
|
|
|
exit;
|
|
|
|
|
|
- { also anonym objects aren't allow (o : object a : longint; end;) }
|
|
|
- if n='' then
|
|
|
- Message(parser_f_no_anonym_objects);
|
|
|
+ if assigned(fd) then
|
|
|
+ aktobjectdef:=fd
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ { anonym objects aren't allow (o : object a : longint; end;) }
|
|
|
+ if n='' then
|
|
|
+ Message(parser_f_no_anonym_objects);
|
|
|
+ aktobjectdef:=tobjectdef.create(classtype,n,nil);
|
|
|
+ { include forward flag, it'll be removed after the parent class have been
|
|
|
+ added. This is to prevent circular childof loops }
|
|
|
+ include(aktobjectdef.objectoptions,oo_is_forward);
|
|
|
+ end;
|
|
|
|
|
|
{ read list of parent classes }
|
|
|
readparentclasses;
|
|
|
|
|
|
+(*
|
|
|
+ { keep reference to implicit parent classes }
|
|
|
+ if (cs_compilesystem in aktmoduleswitches) then
|
|
|
+ begin
|
|
|
+ if (classtype=odt_class) and
|
|
|
+ (upper(n)='TOBJECT') then
|
|
|
+ class_tobject:=aktobjectdef
|
|
|
+ else if (classtype=odt_interfacecom) and
|
|
|
+ (upper(n)='IUNKNOWN') then
|
|
|
+ interface_iunknown:=aktobjectdef;
|
|
|
+ end;
|
|
|
+*)
|
|
|
+
|
|
|
{ default access is public }
|
|
|
there_is_a_destructor:=false;
|
|
|
current_object_option:=[sp_public];
|
|
|
@@ -534,11 +543,9 @@ implementation
|
|
|
{ set class flags and inherits published }
|
|
|
setclassattributes;
|
|
|
|
|
|
- aktobjectdef:=aktclass;
|
|
|
- aktclass.symtable.next:=symtablestack;
|
|
|
- symtablestack:=aktclass.symtable;
|
|
|
+ aktobjectdef.symtable.next:=symtablestack;
|
|
|
+ symtablestack:=aktobjectdef.symtable;
|
|
|
testcurobject:=1;
|
|
|
- curobjectname:=Upper(n);
|
|
|
|
|
|
{ short class declaration ? }
|
|
|
if (classtype<>odt_class) or (token<>_SEMICOLON) then
|
|
|
@@ -551,23 +558,23 @@ implementation
|
|
|
case idtoken of
|
|
|
_PRIVATE :
|
|
|
begin
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_access_specifier_in_interfaces);
|
|
|
consume(_PRIVATE);
|
|
|
current_object_option:=[sp_private];
|
|
|
- include(aktclass.objectoptions,oo_has_private);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_private);
|
|
|
end;
|
|
|
_PROTECTED :
|
|
|
begin
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_access_specifier_in_interfaces);
|
|
|
consume(_PROTECTED);
|
|
|
current_object_option:=[sp_protected];
|
|
|
- include(aktclass.objectoptions,oo_has_protected);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_protected);
|
|
|
end;
|
|
|
_PUBLIC :
|
|
|
begin
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_access_specifier_in_interfaces);
|
|
|
consume(_PUBLIC);
|
|
|
current_object_option:=[sp_public];
|
|
|
@@ -577,14 +584,14 @@ implementation
|
|
|
{ we've to check for a pushlished section in non- }
|
|
|
{ publishable classes later, if a real declaration }
|
|
|
{ this is the way, delphi does it }
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_access_specifier_in_interfaces);
|
|
|
consume(_PUBLISHED);
|
|
|
current_object_option:=[sp_published];
|
|
|
end;
|
|
|
_STRICT :
|
|
|
begin
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_access_specifier_in_interfaces);
|
|
|
consume(_STRICT);
|
|
|
if token=_ID then
|
|
|
@@ -594,13 +601,13 @@ implementation
|
|
|
begin
|
|
|
consume(_PRIVATE);
|
|
|
current_object_option:=[sp_strictprivate];
|
|
|
- include(aktclass.objectoptions,oo_has_strictprivate);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_strictprivate);
|
|
|
end;
|
|
|
_PROTECTED:
|
|
|
begin
|
|
|
consume(_PROTECTED);
|
|
|
current_object_option:=[sp_strictprotected];
|
|
|
- include(aktclass.objectoptions,oo_has_strictprotected);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_strictprotected);
|
|
|
end;
|
|
|
else
|
|
|
message(parser_e_protected_or_private_expected);
|
|
|
@@ -611,11 +618,11 @@ implementation
|
|
|
end;
|
|
|
else
|
|
|
begin
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_vars_in_interfaces);
|
|
|
|
|
|
if (sp_published in current_object_option) and
|
|
|
- not(oo_can_have_published in aktclass.objectoptions) then
|
|
|
+ not(oo_can_have_published in aktobjectdef.objectoptions) then
|
|
|
Message(parser_e_cant_have_published);
|
|
|
|
|
|
read_var_decs([vd_object]);
|
|
|
@@ -631,12 +638,12 @@ implementation
|
|
|
_CLASS :
|
|
|
begin
|
|
|
if (sp_published in current_object_option) and
|
|
|
- not(oo_can_have_published in aktclass.objectoptions) then
|
|
|
+ not(oo_can_have_published in aktobjectdef.objectoptions) then
|
|
|
Message(parser_e_cant_have_published);
|
|
|
|
|
|
oldparse_only:=parse_only;
|
|
|
parse_only:=true;
|
|
|
- pd:=parse_proc_dec(aktclass);
|
|
|
+ pd:=parse_proc_dec(aktobjectdef);
|
|
|
|
|
|
{ this is for error recovery as well as forward }
|
|
|
{ interface mappings, i.e. mapping to a method }
|
|
|
@@ -658,11 +665,11 @@ implementation
|
|
|
|
|
|
{ add procdef options to objectdef options }
|
|
|
if (po_msgint in pd.procoptions) then
|
|
|
- include(aktclass.objectoptions,oo_has_msgint);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_msgint);
|
|
|
if (po_msgstr in pd.procoptions) then
|
|
|
- include(aktclass.objectoptions,oo_has_msgstr);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_msgstr);
|
|
|
if (po_virtualmethod in pd.procoptions) then
|
|
|
- include(aktclass.objectoptions,oo_has_virtual);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_virtual);
|
|
|
|
|
|
chkcpp(pd);
|
|
|
end;
|
|
|
@@ -679,14 +686,14 @@ implementation
|
|
|
_CONSTRUCTOR :
|
|
|
begin
|
|
|
if (sp_published in current_object_option) and
|
|
|
- not(oo_can_have_published in aktclass.objectoptions) then
|
|
|
+ not(oo_can_have_published in aktobjectdef.objectoptions) then
|
|
|
Message(parser_e_cant_have_published);
|
|
|
|
|
|
if not(sp_public in current_object_option) and
|
|
|
not(sp_published in current_object_option) then
|
|
|
Message(parser_w_constructor_should_be_public);
|
|
|
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_con_des_in_interfaces);
|
|
|
|
|
|
oldparse_only:=parse_only;
|
|
|
@@ -700,7 +707,7 @@ implementation
|
|
|
|
|
|
{ add procdef options to objectdef options }
|
|
|
if (po_virtualmethod in pd.procoptions) then
|
|
|
- include(aktclass.objectoptions,oo_has_virtual);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_virtual);
|
|
|
chkcpp(pd);
|
|
|
|
|
|
{ Support hint directives }
|
|
|
@@ -715,13 +722,13 @@ implementation
|
|
|
_DESTRUCTOR :
|
|
|
begin
|
|
|
if (sp_published in current_object_option) and
|
|
|
- not(oo_can_have_published in aktclass.objectoptions) then
|
|
|
+ not(oo_can_have_published in aktobjectdef.objectoptions) then
|
|
|
Message(parser_e_cant_have_published);
|
|
|
|
|
|
if there_is_a_destructor then
|
|
|
Message(parser_n_only_one_destructor);
|
|
|
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
Message(parser_e_no_con_des_in_interfaces);
|
|
|
|
|
|
if not(sp_public in current_object_option) then
|
|
|
@@ -739,7 +746,7 @@ implementation
|
|
|
|
|
|
{ add procdef options to objectdef options }
|
|
|
if (po_virtualmethod in pd.procoptions) then
|
|
|
- include(aktclass.objectoptions,oo_has_virtual);
|
|
|
+ include(aktobjectdef.objectoptions,oo_has_virtual);
|
|
|
|
|
|
chkcpp(pd);
|
|
|
|
|
|
@@ -764,25 +771,24 @@ implementation
|
|
|
end;
|
|
|
|
|
|
{ generate vmt space if needed }
|
|
|
- if not(oo_has_vmt in aktclass.objectoptions) and
|
|
|
- (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktclass.objectoptions<>[]) or
|
|
|
+ if not(oo_has_vmt in aktobjectdef.objectoptions) and
|
|
|
+ (([oo_has_virtual,oo_has_constructor,oo_has_destructor]*aktobjectdef.objectoptions<>[]) or
|
|
|
(classtype in [odt_class])
|
|
|
) then
|
|
|
- aktclass.insertvmt;
|
|
|
+ aktobjectdef.insertvmt;
|
|
|
|
|
|
- if is_interface(aktclass) then
|
|
|
+ if is_interface(aktobjectdef) then
|
|
|
setinterfacemethodoptions;
|
|
|
|
|
|
- { reset }
|
|
|
+ { return defined objectdef }
|
|
|
+ result:=aktobjectdef;
|
|
|
+
|
|
|
+ { restore old state }
|
|
|
+ aktobjectdef:=nil;
|
|
|
testcurobject:=0;
|
|
|
- curobjectname:='';
|
|
|
typecanbeforward:=storetypecanbeforward;
|
|
|
- { restore old state }
|
|
|
symtablestack:=symtablestack.next;
|
|
|
- aktobjectdef:=nil;
|
|
|
current_object_option:=old_object_option;
|
|
|
-
|
|
|
- object_dec:=aktclass;
|
|
|
end;
|
|
|
|
|
|
end.
|
peter