diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 5636b4da5b..03526967ad 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -906,6 +906,7 @@ implementation var oldparse_only: boolean; + flags : tparse_proc_flags; begin case token of _PROCEDURE, @@ -917,7 +918,12 @@ implementation oldparse_only:=parse_only; parse_only:=true; - result:=parse_proc_dec(is_classdef,astruct,hadgeneric); + flags:=[]; + if is_classdef then + include(flags,ppf_classmethod); + if hadgeneric then + include(flags,ppf_generic); + result:=parse_proc_dec(flags,astruct); { this is for error recovery as well as forward } { interface mappings, i.e. mapping to a method } diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index b9a4f658ad..3f06fcf338 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -55,6 +55,12 @@ interface ); tpdflags=set of tpdflag; + tparse_proc_flag=( + ppf_classmethod, + ppf_generic + ); + tparse_proc_flags=set of tparse_proc_flag; + function check_proc_directive(isprocvar:boolean):boolean; function proc_get_importname(pd:tprocdef):string; @@ -66,7 +72,7 @@ interface procedure parse_object_proc_directives(pd:tabstractprocdef); procedure parse_record_proc_directives(pd:tabstractprocdef); function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;isgeneric:boolean;genericdef:tdef;generictypelist:tfphashobjectlist;out pd:tprocdef):boolean; - function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef;isgeneric:boolean):tprocdef; + function parse_proc_dec(flags:tparse_proc_flags;astruct:tabstractrecorddef):tprocdef; procedure parse_proc_dec_finish(pd:tprocdef;isclassmethod:boolean;astruct:tabstractrecorddef); { parse a record method declaration (not a (class) constructor/destructor) } @@ -1599,7 +1605,7 @@ implementation end; end; - function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef;isgeneric:boolean):tprocdef; + function parse_proc_dec(flags:tparse_proc_flags;astruct:tabstractrecorddef):tprocdef; var pd : tprocdef; old_block_type : tblock_type; @@ -1622,11 +1628,11 @@ implementation _FUNCTION : begin consume(_FUNCTION); - if parse_proc_head(astruct,potype_function,isgeneric,nil,nil,pd) then + if parse_proc_head(astruct,potype_function,ppf_generic in flags,nil,nil,pd) then begin { pd=nil when it is a interface mapping } if assigned(pd) then - parse_proc_dec_finish(pd,isclassmethod,astruct) + parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct) else finish_intf_mapping; end @@ -1642,11 +1648,11 @@ implementation _PROCEDURE : begin consume(_PROCEDURE); - if parse_proc_head(astruct,potype_procedure,isgeneric,nil,nil,pd) then + if parse_proc_head(astruct,potype_procedure,ppf_generic in flags,nil,nil,pd) then begin { pd=nil when it is an interface mapping } if assigned(pd) then - parse_proc_dec_finish(pd,isclassmethod,astruct) + parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct) else finish_intf_mapping; end @@ -1657,27 +1663,27 @@ implementation _CONSTRUCTOR : begin consume(_CONSTRUCTOR); - if isclassmethod then + if ppf_classmethod in flags then recover:=not parse_proc_head(astruct,potype_class_constructor,false,nil,nil,pd) else recover:=not parse_proc_head(astruct,potype_constructor,false,nil,nil,pd); if not recover then - parse_proc_dec_finish(pd,isclassmethod,astruct); + parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct); end; _DESTRUCTOR : begin consume(_DESTRUCTOR); - if isclassmethod then + if ppf_classmethod in flags then recover:=not parse_proc_head(astruct,potype_class_destructor,false,nil,nil,pd) else recover:=not parse_proc_head(astruct,potype_destructor,false,nil,nil,pd); if not recover then - parse_proc_dec_finish(pd,isclassmethod,astruct); + parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct); end; else if (token=_OPERATOR) or - (isclassmethod and (idtoken=_OPERATOR)) then + ((ppf_classmethod in flags) and (idtoken=_OPERATOR)) then begin { we need to set the block type to bt_body, so that operator names like ">", "=>" or "<>" are parsed correctly instead of e.g. @@ -1688,7 +1694,7 @@ implementation parse_proc_head(astruct,potype_operator,false,nil,nil,pd); block_type:=old_block_type; if assigned(pd) then - parse_proc_dec_finish(pd,isclassmethod,astruct) + parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct) else begin { recover } @@ -1723,10 +1729,16 @@ implementation function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean;hadgeneric:boolean): tprocdef; var oldparse_only: boolean; + flags : tparse_proc_flags; begin oldparse_only:=parse_only; parse_only:=true; - result:=parse_proc_dec(is_classdef,astruct,hadgeneric); + flags:=[]; + if is_classdef then + include(flags,ppf_classmethod); + if hadgeneric then + include(flags,ppf_generic); + result:=parse_proc_dec(flags,astruct); { this is for error recovery as well as forward } { interface mappings, i.e. mapping to a method } diff --git a/compiler/psub.pas b/compiler/psub.pas index 62aa910313..7cc36f76f1 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -91,6 +91,12 @@ interface {$endif DEBUG_NODE_XML} end; + tread_proc_flag = ( + rpf_classmethod, + rpf_generic + ); + tread_proc_flags = set of tread_proc_flag; + procedure printnode_reset; @@ -107,7 +113,7 @@ interface { reads any routine in the implementation, or a non-method routine declaration in the interface (depending on whether or not parse_only is true) } - procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef; isgeneric:boolean); + procedure read_proc(flags:tread_proc_flags; usefwpd: tprocdef); { parses only the body of a non nested routine; needs a correctly setup pd } procedure read_proc_body(pd:tprocdef); @@ -2692,12 +2698,21 @@ implementation end; - procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef; isgeneric:boolean); + procedure read_proc(flags:tread_proc_flags; usefwpd: tprocdef); { Parses the procedure directives, then parses the procedure body, then generates the code for it } + function convert_flags_to_ppf:tparse_proc_flags;inline; + begin + result:=[]; + if rpf_classmethod in flags then + include(result,ppf_classmethod); + if rpf_generic in flags then + include(result,ppf_generic); + end; + var old_current_procinfo : tprocinfo; old_current_structdef: tabstractrecorddef; @@ -2726,7 +2741,7 @@ implementation if not assigned(usefwpd) then { parse procedure declaration } - pd:=parse_proc_dec(isclassmethod,old_current_structdef,isgeneric) + pd:=parse_proc_dec(convert_flags_to_ppf,old_current_structdef) else pd:=usefwpd; @@ -3029,6 +3044,7 @@ implementation var is_classdef:boolean; + flags : tread_proc_flags; begin is_classdef:=false; hadgeneric:=false; @@ -3090,7 +3106,12 @@ implementation Message(parser_e_procedure_or_function_expected); hadgeneric:=false; end; - read_proc(is_classdef,nil,hadgeneric); + flags:=[]; + if is_classdef then + include(flags,rpf_classmethod); + if hadgeneric then + include(flags,rpf_generic); + read_proc(flags,nil); is_classdef:=false; hadgeneric:=false; end; @@ -3137,7 +3158,7 @@ implementation handle_unexpected_had_generic; if is_classdef then begin - read_proc(is_classdef,nil,false); + read_proc([rpf_classmethod],nil); is_classdef:=false; end else @@ -3194,6 +3215,8 @@ implementation end; end; + var + flags : tread_proc_flags; begin hadgeneric:=false; repeat @@ -3227,7 +3250,10 @@ implementation message(parser_e_procedure_or_function_expected); hadgeneric:=false; end; - read_proc(false,nil,hadgeneric); + flags:=[]; + if hadgeneric then + include(flags,rpf_generic); + read_proc(flags,nil); hadgeneric:=false; end; else diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas index e42d43898a..16ff9a4a7d 100644 --- a/compiler/symcreat.pas +++ b/compiler/symcreat.pas @@ -233,6 +233,7 @@ implementation var oldparse_only: boolean; tmpstr: ansistring; + flags : tread_proc_flags; begin if ((status.verbosity and v_debug)<>0) then begin @@ -256,7 +257,10 @@ implementation current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno); current_scanner.readtoken(false); { and parse it... } - read_proc(is_classdef,usefwpd,false); + flags:=[]; + if is_classdef then + include(flags,rpf_classmethod); + read_proc(flags,usefwpd); parse_only:=oldparse_only; { remove the temporary macro input file again } current_scanner.closeinputfile;