mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 18:03:29 +02:00
Commit of a completely restructured helper implementation. Instead of changing objectdefs with odt_classhelper to odt_class, they'll have the odt_helper type assigned to and this will be kept. This also implies that the parent of a helper is its true parent while the extended type is set to a field in tobjectdef (extendeddef).
This change became necessary of the following reasons:
- Records don't support inheritance, thus for "record helpers" some creativity would have been necessary to implement them; with the new implementation this is more easily
- the new approach allows for easy checks regarding virtual methods and their overrides which would have been more complicated in the old variant
- if someone feels the need the types of helpers (object, interface) can be added rather easily
- unnecessary things like VMT generation can be disabled now
details:
- msg*:
* moved some messages from parser to type
* adjusted a message ("class helper" => "helper")
- symdef.pas:
* renamed "helperparent" to "extendeddef" and changed its type from "tobjectdef" to "tabstractrecorddef", so records can be extended as well (somewhen in the near future)
* removed "finish_class_helper" method as it isn't necessary (luckily I haven't yet adjusted the ObjC variant)
* changed name of "is_objectpascal_classhelper" to "is_objectpascal_helper" to reflect that this function applies to all helper types
* tobjectdef.create: ImplementedInterfaces isn't created for odt_helper anymore
* tobjectdef.alignment: for helpers it's the same as for classes although this shouldn't be used anywhere...
* tobjectdef.vmtmethodoffset: set to 0 for helpers to be sure...
* tobjectdef.needs_inittable: not needed for helpers (no fields allowed)
* is_objectpascal_helper: only needs check for "odt_helper" object type
- symconst.pas:
* changed odt_classhelper to more general odt_helper
* added new type "thelpertype" which is used to check that "(record|class) helper" corresponds with the given extended type (as Delphi XE checks this as well this strict solution can be kept for modes Delphi and ObjFPC)
- symtable.pas:
* extended "searchsym_in_class" with the possibility to disable the search for helper methods (needed for inherited) => this implies changing all occurences of "searchsym_in_class" with a "true" except some special locations
* renamed "search_objectpascal_classhelper" to "search_objectpascal_helper"
* searchsym_in_class:
** when an extended method is defined with "overload" it can be that a same named method of the extended class might be called (sadly this means that this search was unnecessary...)
** contextclassh is the def of the helper in the case of an inherited call inside the helper's implementation
** when methods inside a helper are searched, it must be searched in the extended type first
- ptype.pas:
* single_type is used to parse the parent of a helper as well, so allow a helper if the stoParseClassParent is given (needs check in pdecobj.pas/parse_class_parents for normal classes)
* read_named_type: currently the only case when something <> ht_none is passed to the modified parse_objdec (see below) is when the combination "class helper" is encountered ("record helper" will be another one)
- pinline.pas: adjustment for extended "searchsym_in_class"
- pexpr.pas:
* adjustments regarding "searchsym_in_class" and "is_objectpascal_helper"
* factor/factor_read_id: moved the check for "TSomeClassType.SomeMethod" outside of the "is_class" check
* factor:
** in case of an inherited we need to search inside the extended type first (Note: this needs to be extended to find methods in the helper parent if no method is found in the extended type)
** we also need to disable the search for helper methods when searching for an inherited method (Note: it might be better to introduce a enum to decide whether a helper method should search before or after the methods of the extended type or even never)
- pdecsub.pas:
* insert_self_and_vmt_para: in a helper the type of Self is of the extended type
* pd_abstract, pd_final: more nice error message
* pd_override, pd_message, pd_reintroduce: adjusted checks because now "is_class" is no longer true for helpers
* proc_direcdata: allowed "abstract" for helpers (only to produce a more nice error message)
* parse_proc_direc: adjustment because of "is_objectpascal_helper"
- pdecobj.pas:
* adjustments regarding "is_objectpascal_helper"
* adjusted object_dec to take the type of the helper (class, record) as a parameter to be able to check whether the correct extended type was given
* struct_property_dec: properties are allowed in helpers
* parse_object_options: nothing to be parsed for helpers (at least I hope so ^^)
* parse_parent_classes:
** the parent of a helper is now parsed as a normal parent, the extended type is parsed in an extra procedure
** check for "sealed" no longer needed
** added check that the parsed parent of a helper is indeed a helper
** allow to parse the closing ")" of the helper's parent
* parse_extended_class:
** new procedure that parses the type which is extended
** it checks that the extended type is a class for "class helper" and a record for "record helper"
** it checks that a helper extends the same class or a subclass for class helpers
** it checks that a helper extends the same record for record helpers
* parse_object_members:
** "type", "const", "var" is allowed in helpers
** don't exclude flags regarding virtual methods, they are needed for the checks in mode Delphi (this implies that VMT loading must be disabled for helpers)
* object_dec:
** don't change "odt_helper" to "odt_class", but still include the "oo_is_classhelper" flag
** allow the parsing of object options (there are none)
** parse the extended type for helpers
- pdecl.pas
* adjustment because of extension of object_dec
* types_dec: remove the call to finish_classhelper
- objcdef.pas
* objcaddencodedtype, objcdochecktype: add references to helpers as implicit pointers although that should not be used in any way...
- nld.pas
* tloadnode.pass_typecheck: self is a reference to the extended type
- nflw.pas
* create_for_in_loop: adjustment because of changed procedure and inheritance type
- ncgrtti.pas
* TRTTIWriter.write_rtti_data: disable for helpers for now (I need to check what Delphi does here)
- ncgld.pas
* tcgloadnode.pass_generate_code: virtual methods of helpers are treated as normal methods
- ncgcal.pas
* tcgcallnode.pass_generate_code: virtual methods of helpers are treated as normal methods
- ncal.pas
* tcallnode.pass_typecheck: adjust for extension of tcallcandidates constructor
- htypechk.pas
* tcallcandidates declaration: extend some methods to (dis)allow the search for helper methods (needed for inherited)
* tcallcandidates.collect_overloads_in_struct:
** search first in helpers for methods and stop if none carries the "overload" flag
** move the addition of the procsyms to an extra nested procedure because it's used for helper methods and normal struct methods
git-svn-id: branches/svenbarth/classhelpers@16947 -
This commit is contained in:
svenbarth
parent
d12b198c7f
commit
963a4d7b23
@ -67,12 +67,12 @@ interface
|
||||
FParaNode : tnode;
|
||||
FParaLength : smallint;
|
||||
FAllowVariant : boolean;
|
||||
procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList);
|
||||
procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers:boolean);
|
||||
procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean);
|
||||
procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
|
||||
procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
|
||||
function proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
|
||||
public
|
||||
constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
|
||||
constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
|
||||
constructor create_operator(op:ttoken;ppn:tnode);
|
||||
destructor destroy;override;
|
||||
procedure list(all:boolean);
|
||||
@ -1758,7 +1758,7 @@ implementation
|
||||
TCallCandidates
|
||||
****************************************************************************}
|
||||
|
||||
constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
|
||||
constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
|
||||
begin
|
||||
if not assigned(sym) then
|
||||
internalerror(200411015);
|
||||
@ -1766,7 +1766,7 @@ implementation
|
||||
FProcsym:=sym;
|
||||
FProcsymtable:=st;
|
||||
FParanode:=ppn;
|
||||
create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit);
|
||||
create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers);
|
||||
end;
|
||||
|
||||
|
||||
@ -1776,7 +1776,7 @@ implementation
|
||||
FProcsym:=nil;
|
||||
FProcsymtable:=nil;
|
||||
FParanode:=ppn;
|
||||
create_candidate_list(false,false,false,false);
|
||||
create_candidate_list(false,false,false,false,false);
|
||||
end;
|
||||
|
||||
|
||||
@ -1795,19 +1795,63 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList);
|
||||
procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers:boolean);
|
||||
|
||||
function processprocsym(srsym:tprocsym):boolean;
|
||||
var
|
||||
j : integer;
|
||||
pd : tprocdef;
|
||||
begin
|
||||
{ Store first procsym found }
|
||||
if not assigned(FProcsym) then
|
||||
FProcsym:=srsym;
|
||||
{ add all definitions }
|
||||
result:=false;
|
||||
for j:=0 to srsym.ProcdefList.Count-1 do
|
||||
begin
|
||||
pd:=tprocdef(srsym.ProcdefList[j]);
|
||||
if po_overload in pd.procoptions then
|
||||
result:=true;
|
||||
ProcdefOverloadList.Add(srsym.ProcdefList[j]);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
j : integer;
|
||||
pd : tprocdef;
|
||||
srsym : tsym;
|
||||
hashedid : THashedIDString;
|
||||
hasoverload : boolean;
|
||||
helperdef : tobjectdef;
|
||||
begin
|
||||
if FOperator=NOTOKEN then
|
||||
hashedid.id:=FProcsym.name
|
||||
else
|
||||
hashedid.id:=overloaded_names[FOperator];
|
||||
hasoverload:=false;
|
||||
{ first search for potential symbols in the class helpers (this is
|
||||
disabled in an inherited call if the method is available in the
|
||||
extended class) }
|
||||
if is_class(structdef) then
|
||||
if search_last_objectpascal_helper(tobjectdef(structdef), helperdef) and searchhelpers then
|
||||
begin
|
||||
srsym:=nil;
|
||||
while assigned(helperdef) do
|
||||
begin
|
||||
srsym:=tsym(helperdef.symtable.FindWithHash(hashedid));
|
||||
if assigned(srsym) and
|
||||
{ Delphi allows hiding a property by a procedure with the same name }
|
||||
(srsym.typ=procsym) then
|
||||
begin
|
||||
hasoverload := processprocsym(tprocsym(srsym));
|
||||
{ when there is no explicit overload we stop searching }
|
||||
if not hasoverload then
|
||||
break;
|
||||
end;
|
||||
helperdef:=helperdef.childof;
|
||||
end;
|
||||
if not hasoverload and assigned(srsym) then
|
||||
exit;
|
||||
end;
|
||||
{ now search in the class and its parents or the record }
|
||||
while assigned(structdef) do
|
||||
begin
|
||||
srsym:=tprocsym(structdef.symtable.FindWithHash(hashedid));
|
||||
@ -1815,18 +1859,7 @@ implementation
|
||||
{ Delphi allows hiding a property by a procedure with the same name }
|
||||
(srsym.typ=procsym) then
|
||||
begin
|
||||
{ Store first procsym found }
|
||||
if not assigned(FProcsym) then
|
||||
FProcsym:=tprocsym(srsym);
|
||||
{ add all definitions }
|
||||
hasoverload:=false;
|
||||
for j:=0 to tprocsym(srsym).ProcdefList.Count-1 do
|
||||
begin
|
||||
pd:=tprocdef(tprocsym(srsym).ProcdefList[j]);
|
||||
if po_overload in pd.procoptions then
|
||||
hasoverload:=true;
|
||||
ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]);
|
||||
end;
|
||||
hasoverload:=processprocsym(tprocsym(srsym));
|
||||
{ when there is no explicit overload we stop searching }
|
||||
if not hasoverload then
|
||||
break;
|
||||
@ -1911,7 +1944,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
|
||||
procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
|
||||
var
|
||||
j : integer;
|
||||
pd : tprocdef;
|
||||
@ -1929,7 +1962,7 @@ implementation
|
||||
if not objcidcall and
|
||||
(FOperator=NOTOKEN) and
|
||||
(FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
|
||||
collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList)
|
||||
collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers)
|
||||
else
|
||||
if (FOperator<>NOTOKEN) then
|
||||
begin
|
||||
@ -1939,7 +1972,7 @@ implementation
|
||||
while assigned(pt) do
|
||||
begin
|
||||
if (pt.resultdef.typ=recorddef) then
|
||||
collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList);
|
||||
collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers);
|
||||
pt:=tcallparanode(pt.right);
|
||||
end;
|
||||
collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);
|
||||
|
||||
@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
|
||||
#
|
||||
# Parser
|
||||
#
|
||||
# 03307 is the last used one
|
||||
# 03305 is the last used one
|
||||
#
|
||||
% \section{Parser messages}
|
||||
% This section lists all parser messages. The parser takes care of the
|
||||
@ -917,9 +917,9 @@ parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be us
|
||||
% The access specifiers \var{public}, \var{private}, \var{protected} and
|
||||
% \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods
|
||||
% of an interface/protocol/category must be public.
|
||||
parser_e_no_vars_in_interfaces=03173_E_An interface or class helper or Objective-C protocol or category cannot contain fields
|
||||
% Declarations of fields are not allowed in interfaces, class helpers and Objective-C protocols and categories.
|
||||
% An interface/class helper/protocol/category can contain only methods and properties with method read/write specifiers.
|
||||
parser_e_no_vars_in_interfaces=03173_E_An interface, helper or Objective-C protocol or category cannot contain fields
|
||||
% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories.
|
||||
% An interface/helper/protocol/category can contain only methods and properties with method read/write specifiers.
|
||||
parser_e_no_local_proc_external=03174_E_Can't declare local procedure as EXTERNAL
|
||||
% Declaring local procedures as external is not possible. Local procedures
|
||||
% get hidden parameters that will make the chance of errors very high.
|
||||
@ -1368,18 +1368,13 @@ parser_e_at_least_one_argument_must_be_of_type=03303_E_Either the result or at l
|
||||
parser_e_cant_use_type_parameters_here=03304_E_Type parameters may require initialization/finalization - can't be used in variant records
|
||||
% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization
|
||||
% code which is implicitly generated by the compiler.
|
||||
parser_e_classhelper_id_expected=03305_E_Class helper identifier expected
|
||||
% A class helper can only inherit from another class helper.
|
||||
parser_e_classhelper_must_extend_subclass=03306_E_Derived class helper must extend a subclass of the class extended by the parent class helper
|
||||
% When a class helper inherits from another class helper the extended class must
|
||||
% extend either the same class as the parent class helper or a subclass of it
|
||||
parser_e_not_allowed_in_classhelper=03307_E_"$1" is not allowed in class helpers
|
||||
parser_e_not_allowed_in_classhelper=03305_E_"$1" is not allowed in class helpers
|
||||
% Some directives and specifiers like "virtual", "dynamic", "published" aren't
|
||||
% allowed inside class helpers in mode ObjFPC (they are ignored in mode Delphi).
|
||||
% \end{description}
|
||||
# Type Checking
|
||||
#
|
||||
# 04095 is the last used one
|
||||
# 04100 is the last used one
|
||||
#
|
||||
% \section{Type checking errors}
|
||||
% This section lists all errors that can occur when type checking is
|
||||
@ -1727,6 +1722,16 @@ type_e_type_parameters_are_not_allowed_here=04097_E_Type parameters are not allo
|
||||
% Type parameters are only allowed for methods of generic classes, records or objects
|
||||
type_e_generic_declaration_does_not_match=04098_E_Generic declaration of "$1" differs from previous declaration
|
||||
% Generic declaration does not match the previous declaration
|
||||
type_e_helper_type_expected=04099_E_Helper type expected
|
||||
% The compiler expected a \var{class helper} type.
|
||||
type_e_record_type_expected=04100_E_Record type expected
|
||||
% The compiler expected a \var{record} type.
|
||||
type_e_class_helper_must_extend_subclass=04101_E_Derived class helper must extend a subclass of "$1" or the class itself
|
||||
% If a class helper inherits from another class helper the extended class must
|
||||
% extend either the same class as the parent class helper or a subclass of it
|
||||
type_e_record_helper_must_extend_same_record=04102_E_Derived record helper must extend "$1"
|
||||
% If a record helper inherits from another record helper it must extend the same
|
||||
% record that the parent record helper extended.
|
||||
%
|
||||
% \end{description}
|
||||
#
|
||||
|
||||
@ -393,9 +393,7 @@ const
|
||||
parser_e_no_constructor_in_records=03302;
|
||||
parser_e_at_least_one_argument_must_be_of_type=03303;
|
||||
parser_e_cant_use_type_parameters_here=03304;
|
||||
parser_e_classhelper_id_expected=03305;
|
||||
parser_e_classhelper_must_extend_subclass=03306;
|
||||
parser_e_not_allowed_in_classhelper=03307;
|
||||
parser_e_not_allowed_in_classhelper=03305;
|
||||
type_e_mismatch=04000;
|
||||
type_e_incompatible_types=04001;
|
||||
type_e_not_equal_types=04002;
|
||||
@ -485,6 +483,10 @@ const
|
||||
type_e_generics_cannot_reference_itself=04096;
|
||||
type_e_type_parameters_are_not_allowed_here=04097;
|
||||
type_e_generic_declaration_does_not_match=04098;
|
||||
type_e_helper_type_expected=04099;
|
||||
type_e_record_type_expected=04100;
|
||||
type_e_class_helper_must_extend_subclass=04101;
|
||||
type_e_record_helper_must_extend_same_record=04102;
|
||||
sym_e_id_not_found=05000;
|
||||
sym_f_internal_error_in_symtablestack=05001;
|
||||
sym_e_duplicate_id=05002;
|
||||
@ -885,9 +887,9 @@ const
|
||||
option_info=11024;
|
||||
option_help_pages=11025;
|
||||
|
||||
MsgTxtSize = 58938;
|
||||
MsgTxtSize = 58973;
|
||||
|
||||
MsgIdxMax : array[1..20] of longint=(
|
||||
24,88,308,99,84,54,111,22,202,63,
|
||||
24,88,306,103,84,54,111,22,202,63,
|
||||
49,20,1,1,1,1,1,1,1,1
|
||||
);
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -2693,7 +2693,7 @@ implementation
|
||||
{ ignore possible private for properties or in delphi mode for anon. inherited (FK) }
|
||||
ignorevisibility:=(nf_isproperty in flags) or
|
||||
((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
|
||||
candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags);
|
||||
candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]);
|
||||
|
||||
{ no procedures found? then there is something wrong
|
||||
with the parameter size or the procedures are
|
||||
|
||||
@ -708,6 +708,7 @@ implementation
|
||||
a pointer. We can directly call the correct procdef (PFV) }
|
||||
if (name_to_call='') and
|
||||
(po_virtualmethod in procdefinition.procoptions) and
|
||||
not is_objectpascal_helper(tprocdef(procdefinition).struct) and
|
||||
assigned(methodpointer) and
|
||||
(methodpointer.nodetype<>typen) and
|
||||
not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then
|
||||
|
||||
@ -496,7 +496,8 @@ implementation
|
||||
|
||||
{ virtual method ? }
|
||||
if (po_virtualmethod in procdef.procoptions) and
|
||||
not(nf_inherited in flags) then
|
||||
not(nf_inherited in flags) and
|
||||
not is_objectpascal_helper(procdef.struct) then
|
||||
begin
|
||||
if (not assigned(current_procinfo) or
|
||||
wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then
|
||||
|
||||
@ -920,7 +920,9 @@ implementation
|
||||
recorddef_rtti(trecorddef(def));
|
||||
end;
|
||||
objectdef :
|
||||
objectdef_rtti(tobjectdef(def));
|
||||
// TODO : check whether Delphi generates RTTI for helpers
|
||||
if not is_objectpascal_helper(def) then
|
||||
objectdef_rtti(tobjectdef(def));
|
||||
else
|
||||
unknown_rtti(tstoreddef(def));
|
||||
end;
|
||||
|
||||
@ -866,10 +866,10 @@ implementation
|
||||
{ first search using the class helper hierarchy if it's a
|
||||
class }
|
||||
if (expr.resultdef.typ=objectdef) and
|
||||
search_last_objectpascal_classhelper(tobjectdef(expr.resultdef),classhelper) then
|
||||
search_last_objectpascal_helper(tobjectdef(expr.resultdef),classhelper) then
|
||||
repeat
|
||||
pd:=classhelper.search_enumerator_get;
|
||||
classhelper:=classhelper.helperparent;
|
||||
classhelper:=classhelper.childof;
|
||||
until (pd<>nil) or (classhelper=nil);
|
||||
{ we didn't found a class helper, so search in the
|
||||
class/record/object itself }
|
||||
|
||||
@ -302,6 +302,8 @@ implementation
|
||||
if vo_is_self in tabstractvarsym(symtableentry).varoptions then
|
||||
begin
|
||||
resultdef:=tprocdef(symtableentry.owner.defowner).struct;
|
||||
if is_objectpascal_helper(resultdef) then
|
||||
resultdef:=tobjectdef(resultdef).extendeddef;
|
||||
if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
|
||||
(po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
|
||||
resultdef:=tclassrefdef.create(resultdef)
|
||||
|
||||
@ -374,13 +374,14 @@ implementation
|
||||
encodedstr:=encodedstr+'^?';
|
||||
objectdef :
|
||||
case tobjectdef(def).objecttype of
|
||||
odt_helper,
|
||||
odt_class,
|
||||
odt_object,
|
||||
odt_cppclass:
|
||||
begin
|
||||
newstate:=recordinfostate;
|
||||
{ implicit pointer for classes }
|
||||
if (tobjectdef(def).objecttype=odt_class) then
|
||||
if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then
|
||||
begin
|
||||
encodedstr:=encodedstr+'^';
|
||||
{ make all classes opaque, so even if they contain a
|
||||
@ -593,13 +594,14 @@ implementation
|
||||
;
|
||||
objectdef :
|
||||
case tobjectdef(def).objecttype of
|
||||
odt_helper,
|
||||
odt_class,
|
||||
odt_object,
|
||||
odt_cppclass:
|
||||
begin
|
||||
newstate:=recordinfostate;
|
||||
{ implicit pointer for classes }
|
||||
if (tobjectdef(def).objecttype=odt_class) then
|
||||
if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then
|
||||
begin
|
||||
{ make all classes opaque, so even if they contain a
|
||||
reference-counted field there is no problem. Since a
|
||||
|
||||
@ -500,7 +500,7 @@ implementation
|
||||
end;
|
||||
consume(token);
|
||||
{ we can ignore the result, the definition is modified }
|
||||
object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef));
|
||||
object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
|
||||
newtype:=ttypesym(sym);
|
||||
hdef:=newtype.typedef;
|
||||
end
|
||||
@ -630,9 +630,6 @@ implementation
|
||||
|
||||
if is_cppclass(hdef) then
|
||||
tobjectdef(hdef).finish_cpp_data;
|
||||
|
||||
if is_objectpascal_classhelper(hdef) then
|
||||
tobjectdef(hdef).finish_classhelper;
|
||||
end;
|
||||
recorddef :
|
||||
begin
|
||||
|
||||
@ -30,7 +30,7 @@ interface
|
||||
globtype,symconst,symtype,symdef;
|
||||
|
||||
{ parses a object declaration }
|
||||
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
|
||||
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
|
||||
|
||||
function class_constructor_head:tprocdef;
|
||||
function class_destructor_head:tprocdef;
|
||||
@ -118,8 +118,8 @@ implementation
|
||||
var
|
||||
p : tpropertysym;
|
||||
begin
|
||||
{ check for a class or record }
|
||||
if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef)) or
|
||||
{ check for a class, record or helper }
|
||||
if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or is_objectpascal_helper(current_structdef)) or
|
||||
(not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
|
||||
Message(parser_e_syntax_error);
|
||||
consume(_PROPERTY);
|
||||
@ -422,6 +422,7 @@ implementation
|
||||
get_cpp_class_external_status(current_objectdef);
|
||||
odt_objcclass,odt_objcprotocol,odt_objccategory:
|
||||
get_objc_class_or_protocol_external_status(current_objectdef);
|
||||
odt_helper: ; // nothing
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -436,31 +437,11 @@ implementation
|
||||
intfchildof:=nil;
|
||||
hasparentdefined:=false;
|
||||
|
||||
{ the "parent" of a class helper is not really treated as its parent;
|
||||
it's only used to extend the searched scope }
|
||||
if is_objectpascal_classhelper(current_structdef) then
|
||||
begin
|
||||
if try_to_consume(_LKLAMMER) then
|
||||
begin
|
||||
{ TODO : check what these flags mean }
|
||||
single_type(hdef,[stoAllowTypeDef, stoParseClassParent]);
|
||||
if not is_objectpascal_classhelper(hdef) then
|
||||
begin
|
||||
Message(parser_e_classhelper_id_expected);
|
||||
hdef:=nil;
|
||||
end;
|
||||
current_objectdef.helperparent:=tobjectdef(hdef);
|
||||
consume(_RKLAMMER);
|
||||
end;
|
||||
consume(_FOR);
|
||||
end;
|
||||
|
||||
{ reads the parent class }
|
||||
if (token=_LKLAMMER) or
|
||||
is_classhelper(current_structdef) then
|
||||
is_objccategory(current_structdef) then
|
||||
begin
|
||||
if not is_objectpascal_classhelper(current_structdef) then
|
||||
consume(_LKLAMMER);
|
||||
consume(_LKLAMMER);
|
||||
{ use single_type instead of id_type for specialize support }
|
||||
single_type(hdef,[stoAllowSpecialization, stoParseClassParent]);
|
||||
if (not assigned(hdef)) or
|
||||
@ -470,10 +451,7 @@ implementation
|
||||
Message1(type_e_class_type_expected,hdef.typename)
|
||||
else if is_objccategory(current_structdef) then
|
||||
{ a category must specify the class to extend }
|
||||
Message(type_e_objcclass_type_expected)
|
||||
else if is_objectpascal_classhelper(current_objectdef) then
|
||||
{ a class helper must specify the class to extend }
|
||||
Message(type_e_class_type_expected);
|
||||
Message(type_e_objcclass_type_expected);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -496,8 +474,7 @@ implementation
|
||||
Message(parser_e_mix_of_classes_and_objects);
|
||||
end
|
||||
else
|
||||
if (oo_is_sealed in childof.objectoptions) and
|
||||
not is_objectpascal_classhelper(current_structdef) then
|
||||
if oo_is_sealed in childof.objectoptions then
|
||||
Message1(parser_e_sealed_descendant,childof.typename);
|
||||
odt_interfacecorba,
|
||||
odt_interfacecom:
|
||||
@ -545,6 +522,12 @@ implementation
|
||||
Message1(parser_e_sealed_descendant,childof.typename);
|
||||
odt_dispinterface:
|
||||
Message(parser_e_dispinterface_cant_have_parent);
|
||||
odt_helper:
|
||||
if not is_objectpascal_helper(childof) then
|
||||
begin
|
||||
Message(type_e_helper_type_expected);
|
||||
childof:=nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
hasparentdefined:=true;
|
||||
@ -584,8 +567,7 @@ implementation
|
||||
{ remove forward flag, is resolved }
|
||||
exclude(current_structdef.objectoptions,oo_is_forward);
|
||||
|
||||
if hasparentdefined and
|
||||
not is_objectpascal_classhelper(current_structdef) then
|
||||
if hasparentdefined then
|
||||
begin
|
||||
if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
|
||||
begin
|
||||
@ -600,6 +582,62 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure parse_extended_class(helpertype:thelpertype);
|
||||
var
|
||||
hdef: tdef;
|
||||
begin
|
||||
if not is_objectpascal_helper(current_structdef) then
|
||||
Internalerror(2011021103);
|
||||
if helpertype=ht_none then
|
||||
Internalerror(2011021001);
|
||||
|
||||
consume(_FOR);
|
||||
single_type(hdef,[stoAllowTypeDef,stoParseClassParent]);
|
||||
if (not assigned(hdef)) or
|
||||
not (hdef.typ in [objectdef,recorddef]) then
|
||||
begin
|
||||
if helpertype=ht_class then
|
||||
Message1(type_e_class_type_expected,hdef.typename)
|
||||
else
|
||||
if helpertype=ht_record then
|
||||
Message1(type_e_record_type_expected,hdef.typename);
|
||||
end
|
||||
else
|
||||
begin
|
||||
case helpertype of
|
||||
ht_class:
|
||||
begin
|
||||
if not is_class(hdef) then
|
||||
Message1(type_e_class_type_expected,hdef.typename);
|
||||
{ a class helper must extend the same class or a subclass
|
||||
of the class extended by the parent class helper }
|
||||
if assigned(current_objectdef.childof) then
|
||||
begin
|
||||
if not is_class(current_objectdef.childof.extendeddef) then
|
||||
Internalerror(2011021101);
|
||||
if not hdef.is_related(current_objectdef.childof.extendeddef) then
|
||||
Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename);
|
||||
end;
|
||||
end;
|
||||
ht_record:
|
||||
begin
|
||||
if not is_record(hdef) then
|
||||
Message1(type_e_record_type_expected,hdef.typename);
|
||||
{ a record helper must extend the same record as the
|
||||
parent helper }
|
||||
if assigned(current_objectdef.childof) then
|
||||
begin
|
||||
if not is_record(current_objectdef.childof.extendeddef) then
|
||||
Internalerror(2011021102);
|
||||
if hdef<>current_objectdef.childof.extendeddef then
|
||||
Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
current_objectdef.extendeddef:=tabstractrecorddef(hdef);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure parse_guid;
|
||||
begin
|
||||
@ -675,14 +713,14 @@ implementation
|
||||
case token of
|
||||
_TYPE :
|
||||
begin
|
||||
if not(current_objectdef.objecttype in [odt_class,odt_object]) then
|
||||
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
|
||||
Message(parser_e_type_var_const_only_in_records_and_classes);
|
||||
consume(_TYPE);
|
||||
object_member_blocktype:=bt_type;
|
||||
end;
|
||||
_VAR :
|
||||
begin
|
||||
if not(current_objectdef.objecttype in [odt_class,odt_object]) then
|
||||
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
|
||||
Message(parser_e_type_var_const_only_in_records_and_classes);
|
||||
consume(_VAR);
|
||||
fields_allowed:=true;
|
||||
@ -692,7 +730,7 @@ implementation
|
||||
end;
|
||||
_CONST:
|
||||
begin
|
||||
if not(current_objectdef.objecttype in [odt_class,odt_object]) then
|
||||
if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
|
||||
Message(parser_e_type_var_const_only_in_records_and_classes);
|
||||
consume(_CONST);
|
||||
object_member_blocktype:=bt_const;
|
||||
@ -801,7 +839,7 @@ implementation
|
||||
begin
|
||||
if is_interface(current_structdef) or
|
||||
is_objc_protocol_or_category(current_structdef) or
|
||||
is_objectpascal_classhelper(current_structdef) then
|
||||
is_objectpascal_helper(current_structdef) then
|
||||
Message(parser_e_no_vars_in_interfaces);
|
||||
|
||||
if (current_structdef.symtable.currentvisibility=vis_published) and
|
||||
@ -877,13 +915,6 @@ implementation
|
||||
if (m_mac in current_settings.modeswitches) then
|
||||
include(pd.procoptions,po_virtualmethod);
|
||||
|
||||
{ for class helpers virtual, final, override make no sense,
|
||||
so they are rejected in mode ObjFPC (in pdecsub) and
|
||||
ignored in mode Delphi (here)
|
||||
}
|
||||
if is_objectpascal_classhelper(current_structdef) then
|
||||
pd.procoptions:=pd.procoptions-[po_virtualmethod,po_finalmethod,po_overridingmethod];
|
||||
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
@ -965,7 +996,7 @@ implementation
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ (class) destructors are not allowed in class helpers }
|
||||
if is_objectpascal_classhelper(current_structdef) then
|
||||
if is_objectpascal_helper(current_structdef) then
|
||||
Message(parser_e_no_destructor_in_records);
|
||||
|
||||
if not is_classdef and (current_structdef.symtable.currentvisibility<>vis_public) then
|
||||
@ -1014,7 +1045,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
|
||||
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
|
||||
var
|
||||
old_current_structdef: tabstractrecorddef;
|
||||
old_current_genericdef,
|
||||
@ -1122,16 +1153,12 @@ implementation
|
||||
include(current_structdef.objectoptions,oo_is_classhelper);
|
||||
end;
|
||||
|
||||
{ change classhelpers into Object Pascal style class helpers }
|
||||
if (objecttype=odt_classhelper) then
|
||||
begin
|
||||
current_objectdef.objecttype:=odt_class;
|
||||
include(current_objectdef.objectoptions,oo_is_classhelper);
|
||||
end;
|
||||
{ include the class helper flag for Object Pascal helpers }
|
||||
if (objecttype=odt_helper) then
|
||||
include(current_objectdef.objectoptions,oo_is_classhelper);
|
||||
|
||||
{ parse list of options (abstract / sealed) }
|
||||
if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) and
|
||||
not is_objectpascal_classhelper(current_objectdef) then
|
||||
if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then
|
||||
parse_object_options;
|
||||
|
||||
symtablestack.push(current_structdef.symtable);
|
||||
@ -1141,6 +1168,10 @@ implementation
|
||||
{ parse list of parent classes }
|
||||
parse_parent_classes;
|
||||
|
||||
{ parse extended type for helpers }
|
||||
if is_objectpascal_helper(current_structdef) then
|
||||
parse_extended_class(helpertype);
|
||||
|
||||
{ parse optional GUID for interfaces }
|
||||
parse_guid;
|
||||
|
||||
|
||||
@ -245,6 +245,7 @@ implementation
|
||||
storepos : tfileposinfo;
|
||||
vs : tparavarsym;
|
||||
hdef : tdef;
|
||||
selfdef : tabstractrecorddef;
|
||||
vsp : tvarspez;
|
||||
aliasvs : tabsolutevarsym;
|
||||
sl : tpropaccesslist;
|
||||
@ -302,18 +303,24 @@ implementation
|
||||
pd.parast.insert(vs);
|
||||
end;
|
||||
|
||||
{ for helpers the type of Self is equivalent to the extended
|
||||
type or equal to an instance of it }
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) then
|
||||
selfdef:=tobjectdef(tprocdef(pd).struct).extendeddef
|
||||
else
|
||||
selfdef:=tprocdef(pd).struct;
|
||||
{ Generate self variable, for classes we need
|
||||
to use the generic voidpointer to be compatible with
|
||||
methodpointers }
|
||||
vsp:=vs_value;
|
||||
if (po_staticmethod in pd.procoptions) or
|
||||
(po_classmethod in pd.procoptions) then
|
||||
hdef:=tclassrefdef.create(tprocdef(pd).struct)
|
||||
hdef:=tclassrefdef.create(selfdef)
|
||||
else
|
||||
begin
|
||||
if is_object(tprocdef(pd).struct) or is_record(tprocdef(pd).struct) then
|
||||
if is_object(selfdef) or is_record(selfdef) then
|
||||
vsp:=vs_var;
|
||||
hdef:=tprocdef(pd).struct;
|
||||
hdef:=selfdef;
|
||||
end;
|
||||
vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
|
||||
pd.parast.insert(vs);
|
||||
@ -1621,6 +1628,9 @@ procedure pd_abstract(pd:tabstractprocdef);
|
||||
begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(200304269);
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) and
|
||||
(m_objfpc in current_settings.modeswitches) then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_ABSTRACT].str);
|
||||
if assigned(tprocdef(pd).struct) and
|
||||
(oo_is_sealed in tprocdef(pd).struct.objectoptions) then
|
||||
Message(parser_e_sealed_class_cannot_have_abstract_methods)
|
||||
@ -1637,6 +1647,9 @@ procedure pd_final(pd:tabstractprocdef);
|
||||
begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(200910170);
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) and
|
||||
(m_objfpc in current_settings.modeswitches) then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_FINAL].str);
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(pd.procoptions,po_finalmethod)
|
||||
else
|
||||
@ -1682,7 +1695,7 @@ begin
|
||||
if (pd.proctypeoption=potype_constructor) and
|
||||
is_object(tprocdef(pd).struct) then
|
||||
Message(parser_e_constructor_cannot_be_not_virtual);
|
||||
if is_objectpascal_classhelper(tprocdef(pd).struct) and
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) and
|
||||
(m_objfpc in current_settings.modeswitches) then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_VIRTUAL].str);
|
||||
{$ifdef WITHDMT}
|
||||
@ -1734,9 +1747,11 @@ procedure pd_override(pd:tabstractprocdef);
|
||||
begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(2003042611);
|
||||
if is_objectpascal_classhelper(tprocdef(pd).struct) and
|
||||
(m_objfpc in current_settings.modeswitches) then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_OVERRIDE].str)
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) then
|
||||
begin
|
||||
if m_objfpc in current_settings.modeswitches then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_OVERRIDE].str)
|
||||
end
|
||||
else if not(is_class_or_interface_or_objc(tprocdef(pd).struct)) then
|
||||
Message(parser_e_no_object_override)
|
||||
else if is_objccategory(tprocdef(pd).struct) then
|
||||
@ -1761,12 +1776,15 @@ var
|
||||
begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(2003042613);
|
||||
if not is_class(tprocdef(pd).struct) and
|
||||
not is_objc_class_or_protocol(tprocdef(pd).struct) then
|
||||
Message(parser_e_msg_only_for_classes);
|
||||
if is_objectpascal_classhelper(tprocdef(pd).struct) and
|
||||
(m_objfpc in current_settings.modeswitches) then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_MESSAGE].str);
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) then
|
||||
begin
|
||||
if m_objfpc in current_settings.modeswitches then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_MESSAGE].str);
|
||||
end
|
||||
else
|
||||
if not is_class(tprocdef(pd).struct) and
|
||||
not is_objc_class_or_protocol(tprocdef(pd).struct) then
|
||||
Message(parser_e_msg_only_for_classes);
|
||||
if ([po_msgstr,po_msgint]*pd.procoptions)<>[] then
|
||||
Message(parser_e_multiple_messages);
|
||||
{ check parameter type }
|
||||
@ -1795,7 +1813,8 @@ begin
|
||||
end
|
||||
else
|
||||
if is_constintnode(pt) and
|
||||
is_class(tprocdef(pd).struct) then
|
||||
(is_class(tprocdef(pd).struct) or
|
||||
is_objectpascal_helper(tprocdef(pd).struct)) then
|
||||
begin
|
||||
include(pd.procoptions,po_msgint);
|
||||
if (Tordconstnode(pt).value<int64(low(Tprocdef(pd).messageinf.i))) or
|
||||
@ -1819,12 +1838,15 @@ procedure pd_reintroduce(pd:tabstractprocdef);
|
||||
begin
|
||||
if pd.typ<>procdef then
|
||||
internalerror(200401211);
|
||||
if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and
|
||||
not(is_objccategory(tprocdef(pd).struct)) then
|
||||
Message(parser_e_no_object_reintroduce);
|
||||
if is_objectpascal_classhelper(tprocdef(pd).struct) and
|
||||
(m_objfpc in current_settings.modeswitches) then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_REINTRODUCE].str);
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) then
|
||||
begin
|
||||
if m_objfpc in current_settings.modeswitches then
|
||||
Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_REINTRODUCE].str);
|
||||
end
|
||||
else
|
||||
if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and
|
||||
not(is_objccategory(tprocdef(pd).struct)) then
|
||||
Message(parser_e_no_object_reintroduce);
|
||||
end;
|
||||
|
||||
|
||||
@ -2104,7 +2126,7 @@ const
|
||||
(
|
||||
(
|
||||
idtok:_ABSTRACT;
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord,pd_nothelper];
|
||||
pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord];
|
||||
handler : @pd_abstract;
|
||||
pocall : pocall_none;
|
||||
pooption : [po_abstractmethod];
|
||||
@ -2639,7 +2661,7 @@ const
|
||||
exit;
|
||||
|
||||
{ check if method and directive not for record/class helper }
|
||||
if is_objectpascal_classhelper(tprocdef(pd).struct) and
|
||||
if is_objectpascal_helper(tprocdef(pd).struct) and
|
||||
(pd_nothelper in proc_direcdata[p].pd_flags) then
|
||||
exit;
|
||||
|
||||
|
||||
@ -1031,7 +1031,7 @@ implementation
|
||||
else
|
||||
static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
|
||||
if sym.owner.defowner.typ=objectdef then
|
||||
searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable)
|
||||
searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable,true)
|
||||
else
|
||||
searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable);
|
||||
if assigned(sym) then
|
||||
@ -1489,7 +1489,7 @@ implementation
|
||||
p1:=comp_expr(true,false);
|
||||
consume(_RKLAMMER);
|
||||
{ type casts to class helpers aren't allowed }
|
||||
if is_objectpascal_classhelper(hdef) then
|
||||
if is_objectpascal_helper(hdef) then
|
||||
Message(parser_e_no_category_as_types)
|
||||
{ recovery by not creating a conversion node }
|
||||
else
|
||||
@ -1508,7 +1508,7 @@ implementation
|
||||
begin
|
||||
p1:=ctypenode.create(hdef);
|
||||
{ search also in inherited methods }
|
||||
searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable);
|
||||
searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,true);
|
||||
if assigned(srsym) then
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
|
||||
consume(_ID);
|
||||
@ -1535,16 +1535,17 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ TClassHelper.Something is not allowed }
|
||||
if is_objectpascal_helper(hdef) then
|
||||
begin
|
||||
Message(parser_e_no_category_as_types);
|
||||
{ for recovery we use the extended class }
|
||||
hdef:=tobjectdef(hdef).extendeddef;
|
||||
end;
|
||||
{ class reference ? }
|
||||
if is_class(hdef) or
|
||||
is_objcclass(hdef) then
|
||||
begin
|
||||
if is_objectpascal_classhelper(hdef) then
|
||||
begin
|
||||
Message(parser_e_no_category_as_types);
|
||||
{ for recovery we use the extended class }
|
||||
hdef:=tobjectdef(hdef).childof;
|
||||
end;
|
||||
if getaddr and (token=_POINT) then
|
||||
begin
|
||||
consume(_POINT);
|
||||
@ -2140,7 +2141,7 @@ implementation
|
||||
if token=_ID then
|
||||
begin
|
||||
structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
|
||||
searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable);
|
||||
searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
|
||||
@ -2164,7 +2165,7 @@ implementation
|
||||
if token=_ID then
|
||||
begin
|
||||
structh:=tobjectdef(p1.resultdef);
|
||||
searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable);
|
||||
searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
|
||||
@ -2354,7 +2355,16 @@ implementation
|
||||
assigned(current_structdef) and
|
||||
(current_structdef.typ=objectdef) then
|
||||
begin
|
||||
hclassdef:=tobjectdef(current_structdef).childof;
|
||||
{ In Object Pascal helpers "inherited" always calls a
|
||||
method of the extended class }
|
||||
if is_objectpascal_helper(current_structdef) then
|
||||
begin
|
||||
if not is_class(tobjectdef(current_structdef).extendeddef) then
|
||||
Internalerror(2011021701);
|
||||
hclassdef:=tobjectdef(tobjectdef(current_structdef).extendeddef);
|
||||
end
|
||||
else
|
||||
hclassdef:=tobjectdef(current_structdef).childof;
|
||||
{ Objective-C categories *replace* methods in the class
|
||||
they extend, or add methods to it. So calling an
|
||||
inherited method always calls the method inherited from
|
||||
@ -2378,7 +2388,8 @@ implementation
|
||||
if (po_msgstr in pd.procoptions) then
|
||||
searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
|
||||
else
|
||||
searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable);
|
||||
{ disable search for helpers }
|
||||
searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,false);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -2386,7 +2397,8 @@ implementation
|
||||
hsorg:=orgpattern;
|
||||
consume(_ID);
|
||||
anon_inherited:=false;
|
||||
searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable);
|
||||
{ disable search for helpers }
|
||||
searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,false);
|
||||
end;
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
@ -2420,7 +2432,7 @@ implementation
|
||||
if (po_msgint in pd.procoptions) or
|
||||
(po_msgstr in pd.procoptions) then
|
||||
begin
|
||||
searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable);
|
||||
searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,true);
|
||||
if not assigned(srsym) or
|
||||
(srsym.typ<>procsym) then
|
||||
internalerror(200303171);
|
||||
|
||||
@ -434,7 +434,7 @@ implementation
|
||||
{ search the constructor also in the symbol tables of
|
||||
the parents }
|
||||
afterassignment:=false;
|
||||
searchsym_in_class(classh,classh,pattern,srsym,srsymtable);
|
||||
searchsym_in_class(classh,classh,pattern,srsym,srsymtable,true);
|
||||
consume(_ID);
|
||||
do_member_read(classh,false,srsym,p1,again,[cnf_new_call]);
|
||||
{ we need to know which procedure is called }
|
||||
|
||||
@ -568,7 +568,8 @@ implementation
|
||||
Message(parser_e_no_generics_as_types);
|
||||
def:=generrordef;
|
||||
end
|
||||
else if is_classhelper(def) then
|
||||
else if is_classhelper(def) and
|
||||
not (stoParseClassParent in options) then
|
||||
begin
|
||||
Message(parser_e_no_category_as_types);
|
||||
def:=generrordef
|
||||
@ -1498,12 +1499,12 @@ implementation
|
||||
_CLASS :
|
||||
begin
|
||||
consume(_CLASS);
|
||||
def:=object_dec(odt_class,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_OBJECT :
|
||||
begin
|
||||
consume(_OBJECT);
|
||||
def:=object_dec(odt_object,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
else
|
||||
def:=record_dec(name,genericdef,genericlist);
|
||||
@ -1518,7 +1519,7 @@ implementation
|
||||
if not(m_class in current_settings.modeswitches) then
|
||||
Message(parser_f_need_objfpc_or_delphi_mode);
|
||||
consume(token);
|
||||
def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_CLASS :
|
||||
begin
|
||||
@ -1548,15 +1549,15 @@ implementation
|
||||
if (idtoken=_HELPER) then
|
||||
begin
|
||||
consume(_HELPER);
|
||||
def:=object_dec(odt_classhelper,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_class);
|
||||
end
|
||||
else
|
||||
def:=object_dec(odt_class,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_CPPCLASS :
|
||||
begin
|
||||
consume(token);
|
||||
def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_OBJCCLASS :
|
||||
begin
|
||||
@ -1564,7 +1565,7 @@ implementation
|
||||
Message(parser_f_need_objc);
|
||||
|
||||
consume(token);
|
||||
def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_INTERFACE :
|
||||
begin
|
||||
@ -1574,9 +1575,9 @@ implementation
|
||||
Message(parser_f_need_objfpc_or_delphi_mode);
|
||||
consume(token);
|
||||
if current_settings.interfacetype=it_interfacecom then
|
||||
def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil)
|
||||
def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil,ht_none)
|
||||
else {it_interfacecorba}
|
||||
def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_OBJCPROTOCOL :
|
||||
begin
|
||||
@ -1584,7 +1585,7 @@ implementation
|
||||
Message(parser_f_need_objc);
|
||||
|
||||
consume(token);
|
||||
def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_OBJCCATEGORY :
|
||||
begin
|
||||
@ -1592,12 +1593,12 @@ implementation
|
||||
Message(parser_f_need_objc);
|
||||
|
||||
consume(token);
|
||||
def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_OBJECT :
|
||||
begin
|
||||
consume(token);
|
||||
def:=object_dec(odt_object,name,genericdef,genericlist,nil);
|
||||
def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
|
||||
end;
|
||||
_PROCEDURE,
|
||||
_FUNCTION:
|
||||
|
||||
@ -329,7 +329,13 @@ type
|
||||
odt_objcclass,
|
||||
odt_objcprotocol,
|
||||
odt_objccategory, { note that these are changed into odt_class afterwards }
|
||||
odt_classhelper
|
||||
odt_helper
|
||||
);
|
||||
|
||||
{ defines the type of the extended "structure"; only used for parsing }
|
||||
thelpertype=(ht_none,
|
||||
ht_class,
|
||||
ht_record
|
||||
);
|
||||
|
||||
{ Variations in interfaces implementation }
|
||||
|
||||
@ -259,12 +259,9 @@ interface
|
||||
childof : tobjectdef;
|
||||
childofderef : tderef;
|
||||
|
||||
{ for Object Pascal class helpers: the parent class helper is only
|
||||
used to extend the scope of a used class helper by another class
|
||||
helper for the same extended class or a superclass (which is defined
|
||||
by childof }
|
||||
helperparent : tobjectdef;
|
||||
helperparentderef: tderef;
|
||||
{ for Object Pascal helpers }
|
||||
extendeddef : tabstractrecorddef;
|
||||
extendeddefderef: tderef;
|
||||
{ for C++ classes: name of the library this class is imported from }
|
||||
import_lib,
|
||||
{ for Objective-C: protocols and classes can have the same name there }
|
||||
@ -322,7 +319,6 @@ interface
|
||||
procedure set_parent(c : tobjectdef);
|
||||
function find_destructor: tprocdef;
|
||||
function implements_any_interfaces: boolean;
|
||||
procedure finish_classhelper;
|
||||
{ dispinterface support }
|
||||
function get_next_dispid: longint;
|
||||
{ enumerator support }
|
||||
@ -788,7 +784,7 @@ interface
|
||||
function is_object(def: tdef): boolean;
|
||||
function is_class(def: tdef): boolean;
|
||||
function is_cppclass(def: tdef): boolean;
|
||||
function is_objectpascal_classhelper(def: tdef): boolean;
|
||||
function is_objectpascal_helper(def: tdef): boolean;
|
||||
function is_objcclass(def: tdef): boolean;
|
||||
function is_objcclassref(def: tdef): boolean;
|
||||
function is_objcprotocol(def: tdef): boolean;
|
||||
@ -4153,7 +4149,7 @@ implementation
|
||||
fcurrent_dispid:=0;
|
||||
objecttype:=ot;
|
||||
childof:=nil;
|
||||
if objecttype in [odt_classhelper] then
|
||||
if objecttype=odt_helper then
|
||||
owner.includeoption(sto_has_classhelper);
|
||||
symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
|
||||
{ create space for vmt !! }
|
||||
@ -4163,7 +4159,7 @@ implementation
|
||||
if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
|
||||
prepareguid;
|
||||
{ setup implemented interfaces }
|
||||
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_classhelper] then
|
||||
if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
|
||||
ImplementedInterfaces:=TFPObjectList.Create(true)
|
||||
else
|
||||
ImplementedInterfaces:=nil;
|
||||
@ -4205,8 +4201,8 @@ implementation
|
||||
iidstr:=stringdup(ppufile.getstring);
|
||||
end;
|
||||
|
||||
if oo_is_classhelper in objectoptions then
|
||||
ppufile.getderef(helperparentderef);
|
||||
if objecttype=odt_helper then
|
||||
ppufile.getderef(extendeddefderef);
|
||||
|
||||
vmtentries:=TFPList.Create;
|
||||
vmtentries.count:=ppufile.getlongint;
|
||||
@ -4369,8 +4365,8 @@ implementation
|
||||
ppufile.putguid(iidguid^);
|
||||
ppufile.putstring(iidstr^);
|
||||
end;
|
||||
if oo_is_classhelper in objectoptions then
|
||||
ppufile.putderef(helperparentderef);
|
||||
if objecttype=odt_helper then
|
||||
ppufile.putderef(extendeddefderef);
|
||||
|
||||
ppufile.putlongint(vmtentries.count);
|
||||
for i:=0 to vmtentries.count-1 do
|
||||
@ -4429,8 +4425,8 @@ implementation
|
||||
else
|
||||
tstoredsymtable(symtable).buildderef;
|
||||
|
||||
if oo_is_classhelper in objectoptions then
|
||||
helperparentderef.build(helperparent);
|
||||
if objecttype=odt_helper then
|
||||
extendeddefderef.build(extendeddef);
|
||||
|
||||
for i:=0 to vmtentries.count-1 do
|
||||
begin
|
||||
@ -4460,8 +4456,8 @@ implementation
|
||||
end
|
||||
else
|
||||
tstoredsymtable(symtable).deref;
|
||||
if oo_is_classhelper in objectoptions then
|
||||
helperparent:=tobjectdef(helperparentderef.resolve);
|
||||
if objecttype=odt_helper then
|
||||
extendeddef:=tobjectdef(extendeddefderef.resolve);
|
||||
for i:=0 to vmtentries.count-1 do
|
||||
begin
|
||||
vmtentry:=pvmtentry(vmtentries[i]);
|
||||
@ -4743,14 +4739,9 @@ implementation
|
||||
(assigned(childof) and childof.implements_any_interfaces);
|
||||
end;
|
||||
|
||||
procedure tobjectdef.finish_classhelper;
|
||||
begin
|
||||
self.symtable.DefList.foreachcall(@create_class_helper_for_procdef,nil);
|
||||
end;
|
||||
|
||||
function tobjectdef.size : aint;
|
||||
begin
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
|
||||
result:=sizeof(pint)
|
||||
else
|
||||
result:=tObjectSymtable(symtable).datasize;
|
||||
@ -4759,7 +4750,7 @@ implementation
|
||||
|
||||
function tobjectdef.alignment:shortint;
|
||||
begin
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
|
||||
if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
|
||||
alignment:=sizeof(pint)
|
||||
else
|
||||
alignment:=tObjectSymtable(symtable).recordalignment;
|
||||
@ -4773,6 +4764,7 @@ implementation
|
||||
odt_class:
|
||||
{ the +2*sizeof(pint) is size and -size }
|
||||
vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint);
|
||||
odt_helper,
|
||||
odt_objcclass,
|
||||
odt_objcprotocol:
|
||||
vmtmethodoffset:=0;
|
||||
@ -4799,6 +4791,7 @@ implementation
|
||||
function tobjectdef.needs_inittable : boolean;
|
||||
begin
|
||||
case objecttype of
|
||||
odt_helper,
|
||||
odt_class :
|
||||
needs_inittable:=false;
|
||||
odt_dispinterface,
|
||||
@ -5472,16 +5465,12 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function is_objectpascal_classhelper(def: tdef): boolean;
|
||||
function is_objectpascal_helper(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
assigned(def) and
|
||||
(def.typ=objectdef) and
|
||||
{ if used as a forward type }
|
||||
((tobjectdef(def).objecttype=odt_classhelper) or
|
||||
{ if used as after it has been resolved }
|
||||
((tobjectdef(def).objecttype=odt_class) and
|
||||
(oo_is_classhelper in tobjectdef(def).objectoptions)));
|
||||
(tobjectdef(def).objecttype=odt_helper);
|
||||
end;
|
||||
|
||||
|
||||
@ -5537,7 +5526,7 @@ implementation
|
||||
function is_classhelper(def: tdef): boolean;
|
||||
begin
|
||||
result:=
|
||||
is_objectpascal_classhelper(def) or
|
||||
is_objectpascal_helper(def) or
|
||||
is_objccategory(def);
|
||||
end;
|
||||
|
||||
|
||||
@ -220,7 +220,7 @@ interface
|
||||
function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
|
||||
function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean;
|
||||
function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
@ -229,7 +229,7 @@ interface
|
||||
function search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
|
||||
function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
|
||||
function search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
|
||||
function search_last_objectpascal_classhelper(pd : tobjectdef;out odef : tobjectdef):boolean;
|
||||
function search_last_objectpascal_helper(pd : tabstractrecorddef;out odef : tobjectdef):boolean;
|
||||
function search_objectpascal_class_helper(pd,contextclassh : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
||||
function search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
||||
function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
|
||||
@ -1906,7 +1906,7 @@ implementation
|
||||
srsymtable:=stackitem^.symtable;
|
||||
if (srsymtable.symtabletype=objectsymtable) then
|
||||
begin
|
||||
if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable) then
|
||||
if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then
|
||||
begin
|
||||
result:=true;
|
||||
exit;
|
||||
@ -2136,19 +2136,27 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
|
||||
function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean;
|
||||
var
|
||||
hashedid : THashedIDString;
|
||||
exdef : tabstractrecorddef;
|
||||
orgclass : tobjectdef;
|
||||
i : longint;
|
||||
begin
|
||||
{ search for a class helper method first if this is an Object Pascal
|
||||
class }
|
||||
if is_class(classh) then
|
||||
if is_class(classh) and searchhelper then
|
||||
begin
|
||||
result:=search_objectpascal_class_helper(classh,contextclassh,s,srsym,srsymtable);
|
||||
if result then
|
||||
exit;
|
||||
begin
|
||||
{ if the procsym is overloaded we need to use the "original"
|
||||
symbol; the helper symbol will be find when searching for
|
||||
overloads }
|
||||
if (srsym.typ<>procsym) or
|
||||
not (sp_has_overloaded in tprocsym(srsym).symoptions) then
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
orgclass:=classh;
|
||||
@ -2159,8 +2167,9 @@ implementation
|
||||
classh:=find_real_objcclass_definition(classh,true);
|
||||
{ The contextclassh is used for visibility. The classh must be equal to
|
||||
or be a parent of contextclassh. E.g. for inherited searches the classh is the
|
||||
parent. }
|
||||
if not contextclassh.is_related(classh) then
|
||||
parent or a class helper. }
|
||||
if not (contextclassh.is_related(classh) or
|
||||
(contextclassh.extendeddef=classh)) then
|
||||
internalerror(200811161);
|
||||
end;
|
||||
result:=false;
|
||||
@ -2180,7 +2189,7 @@ implementation
|
||||
end;
|
||||
for i:=0 to classh.ImplementedInterfaces.count-1 do
|
||||
begin
|
||||
if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable) then
|
||||
if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable,true) then
|
||||
begin
|
||||
result:=true;
|
||||
exit;
|
||||
@ -2189,6 +2198,24 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ if we're searching for a symbol inside a helper, we must search in
|
||||
the extended class/record/whatever first }
|
||||
if is_objectpascal_helper(classh) then
|
||||
begin
|
||||
{ important: disable the search for helpers here! }
|
||||
if is_class(classh.extendeddef) and
|
||||
searchsym_in_class(tobjectdef(classh.extendeddef), tobjectdef(classh.extendeddef), s, srsym, srsymtable, false) then
|
||||
begin
|
||||
result:=true;
|
||||
exit;
|
||||
end
|
||||
else if is_record(classh.extendeddef) and
|
||||
searchsym_in_record(classh.extendeddef, s, srsym, srsymtable) then
|
||||
begin
|
||||
result:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
while assigned(classh) do
|
||||
begin
|
||||
srsymtable:=classh.symtable;
|
||||
@ -2435,7 +2462,7 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
function search_last_objectpascal_classhelper(pd : tobjectdef;out odef : tobjectdef):boolean;
|
||||
function search_last_objectpascal_helper(pd : tabstractrecorddef;out odef : tobjectdef):boolean;
|
||||
var
|
||||
stackitem : psymtablestackitem;
|
||||
i : integer;
|
||||
@ -2455,11 +2482,11 @@ implementation
|
||||
begin
|
||||
if not (srsymtable.symlist[i] is ttypesym) then
|
||||
continue;
|
||||
if not is_objectpascal_classhelper(ttypesym(srsymtable.symlist[i]).typedef) then
|
||||
if not is_objectpascal_helper(ttypesym(srsymtable.symlist[i]).typedef) then
|
||||
continue;
|
||||
odef:=tobjectdef(ttypesym(srsymtable.symlist[i]).typedef);
|
||||
{ does the class helper extend the correct class? }
|
||||
result:=odef.childof=pd;
|
||||
result:=odef.extendeddef=pd;
|
||||
if result then
|
||||
exit
|
||||
else
|
||||
@ -2482,7 +2509,7 @@ implementation
|
||||
|
||||
{ if there is no class helper for the class then there is no need to
|
||||
search further }
|
||||
if not search_last_objectpascal_classhelper(pd,classh) then
|
||||
if not search_last_objectpascal_helper(pd,classh) then
|
||||
exit;
|
||||
|
||||
hashedid.id:=s;
|
||||
@ -2524,8 +2551,8 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
{ try the class helper "parent" if available }
|
||||
classh:=classh.helperparent;
|
||||
{ try the class helper parent if available }
|
||||
classh:=classh.childof;
|
||||
until classh=nil;
|
||||
|
||||
srsym:=nil;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user