paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 18:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* combine the Boolean parameters of read_proc and read_proc_dec into a set

Browse Source
This commit is contained in:
Sven/Sarah Barth 2021-05-01 22:11:11 +02:00
parent 934e3bba63
commit f6a444c6fc
4 changed files with 69 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
compiler/pdecobj.pas
View File

@ -906,6 +906,7 @@ implementation
var var
oldparse_only: boolean; oldparse_only: boolean;
flags : tparse_proc_flags;
begin begin
case token of case token of
_PROCEDURE, _PROCEDURE,
@ -917,7 +918,12 @@ implementation
oldparse_only:=parse_only; oldparse_only:=parse_only;
parse_only:=true; 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 } { this is for error recovery as well as forward }
{ interface mappings, i.e. mapping to a method } { interface mappings, i.e. mapping to a method }

38
compiler/pdecsub.pas
View File

@ -55,6 +55,12 @@ interface
); );
tpdflags=set of tpdflag; 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 check_proc_directive(isprocvar:boolean):boolean;
function proc_get_importname(pd:tprocdef):string; function proc_get_importname(pd:tprocdef):string;
@ -66,7 +72,7 @@ interface
procedure parse_object_proc_directives(pd:tabstractprocdef); procedure parse_object_proc_directives(pd:tabstractprocdef);
procedure parse_record_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_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); procedure parse_proc_dec_finish(pd:tprocdef;isclassmethod:boolean;astruct:tabstractrecorddef);
{ parse a record method declaration (not a (class) constructor/destructor) } { parse a record method declaration (not a (class) constructor/destructor) }
@ -1599,7 +1605,7 @@ implementation
end; end;
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 var
pd : tprocdef; pd : tprocdef;
old_block_type : tblock_type; old_block_type : tblock_type;
@ -1622,11 +1628,11 @@ implementation
_FUNCTION : _FUNCTION :
begin begin
consume(_FUNCTION); 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 begin
{ pd=nil when it is a interface mapping } { pd=nil when it is a interface mapping }
if assigned(pd) then if assigned(pd) then
parse_proc_dec_finish(pd,isclassmethod,astruct) parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct)
else else
finish_intf_mapping; finish_intf_mapping;
end end
@ -1642,11 +1648,11 @@ implementation
_PROCEDURE : _PROCEDURE :
begin begin
consume(_PROCEDURE); 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 begin
{ pd=nil when it is an interface mapping } { pd=nil when it is an interface mapping }
if assigned(pd) then if assigned(pd) then
parse_proc_dec_finish(pd,isclassmethod,astruct) parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct)
else else
finish_intf_mapping; finish_intf_mapping;
end end
@ -1657,27 +1663,27 @@ implementation
_CONSTRUCTOR : _CONSTRUCTOR :
begin begin
consume(_CONSTRUCTOR); consume(_CONSTRUCTOR);
if isclassmethod then if ppf_classmethod in flags then
recover:=not parse_proc_head(astruct,potype_class_constructor,false,nil,nil,pd) recover:=not parse_proc_head(astruct,potype_class_constructor,false,nil,nil,pd)
else else
recover:=not parse_proc_head(astruct,potype_constructor,false,nil,nil,pd); recover:=not parse_proc_head(astruct,potype_constructor,false,nil,nil,pd);
if not recover then if not recover then
parse_proc_dec_finish(pd,isclassmethod,astruct); parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct);
end; end;
_DESTRUCTOR : _DESTRUCTOR :
begin begin
consume(_DESTRUCTOR); consume(_DESTRUCTOR);
if isclassmethod then if ppf_classmethod in flags then
recover:=not parse_proc_head(astruct,potype_class_destructor,false,nil,nil,pd) recover:=not parse_proc_head(astruct,potype_class_destructor,false,nil,nil,pd)
else else
recover:=not parse_proc_head(astruct,potype_destructor,false,nil,nil,pd); recover:=not parse_proc_head(astruct,potype_destructor,false,nil,nil,pd);
if not recover then if not recover then
parse_proc_dec_finish(pd,isclassmethod,astruct); parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct);
end; end;
else else
if (token=_OPERATOR) or if (token=_OPERATOR) or
(isclassmethod and (idtoken=_OPERATOR)) then ((ppf_classmethod in flags) and (idtoken=_OPERATOR)) then
begin begin
{ we need to set the block type to bt_body, so that operator names { we need to set the block type to bt_body, so that operator names
like ">", "=>" or "<>" are parsed correctly instead of e.g. like ">", "=>" or "<>" are parsed correctly instead of e.g.
@ -1688,7 +1694,7 @@ implementation
parse_proc_head(astruct,potype_operator,false,nil,nil,pd); parse_proc_head(astruct,potype_operator,false,nil,nil,pd);
block_type:=old_block_type; block_type:=old_block_type;
if assigned(pd) then if assigned(pd) then
parse_proc_dec_finish(pd,isclassmethod,astruct) parse_proc_dec_finish(pd,ppf_classmethod in flags,astruct)
else else
begin begin
{ recover } { recover }
@ -1723,10 +1729,16 @@ implementation
function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean;hadgeneric:boolean): tprocdef; function parse_record_method_dec(astruct: tabstractrecorddef; is_classdef: boolean;hadgeneric:boolean): tprocdef;
var var
oldparse_only: boolean; oldparse_only: boolean;
flags : tparse_proc_flags;
begin begin
oldparse_only:=parse_only; oldparse_only:=parse_only;
parse_only:=true; 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 } { this is for error recovery as well as forward }
{ interface mappings, i.e. mapping to a method } { interface mappings, i.e. mapping to a method }

38
compiler/psub.pas
View File

@ -91,6 +91,12 @@ interface
{$endif DEBUG_NODE_XML} {$endif DEBUG_NODE_XML}
end; end;
tread_proc_flag = (
rpf_classmethod,
rpf_generic
);
tread_proc_flags = set of tread_proc_flag;
procedure printnode_reset; procedure printnode_reset;
@ -107,7 +113,7 @@ interface
{ reads any routine in the implementation, or a non-method routine { reads any routine in the implementation, or a non-method routine
declaration in the interface (depending on whether or not parse_only is declaration in the interface (depending on whether or not parse_only is
true) } 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 } { parses only the body of a non nested routine; needs a correctly setup pd }
procedure read_proc_body(pd:tprocdef); procedure read_proc_body(pd:tprocdef);
@ -2692,12 +2698,21 @@ implementation
end; 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 Parses the procedure directives, then parses the procedure body, then
generates the code for it 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 var
old_current_procinfo : tprocinfo; old_current_procinfo : tprocinfo;
old_current_structdef: tabstractrecorddef; old_current_structdef: tabstractrecorddef;
@ -2726,7 +2741,7 @@ implementation
if not assigned(usefwpd) then if not assigned(usefwpd) then
{ parse procedure declaration } { parse procedure declaration }
pd:=parse_proc_dec(isclassmethod,old_current_structdef,isgeneric) pd:=parse_proc_dec(convert_flags_to_ppf,old_current_structdef)
else else
pd:=usefwpd; pd:=usefwpd;
@ -3029,6 +3044,7 @@ implementation
var var
is_classdef:boolean; is_classdef:boolean;
flags : tread_proc_flags;
begin begin
is_classdef:=false; is_classdef:=false;
hadgeneric:=false; hadgeneric:=false;
@ -3090,7 +3106,12 @@ implementation
Message(parser_e_procedure_or_function_expected); Message(parser_e_procedure_or_function_expected);
hadgeneric:=false; hadgeneric:=false;
end; 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; is_classdef:=false;
hadgeneric:=false; hadgeneric:=false;
end; end;
@ -3137,7 +3158,7 @@ implementation
handle_unexpected_had_generic; handle_unexpected_had_generic;
if is_classdef then if is_classdef then
begin begin
read_proc(is_classdef,nil,false); read_proc([rpf_classmethod],nil);
is_classdef:=false; is_classdef:=false;
end end
else else
@ -3194,6 +3215,8 @@ implementation
end; end;
end; end;
var
flags : tread_proc_flags;
begin begin
hadgeneric:=false; hadgeneric:=false;
repeat repeat
@ -3227,7 +3250,10 @@ implementation
message(parser_e_procedure_or_function_expected); message(parser_e_procedure_or_function_expected);
hadgeneric:=false; hadgeneric:=false;
end; end;
read_proc(false,nil,hadgeneric); flags:=[];
if hadgeneric then
include(flags,rpf_generic);
read_proc(flags,nil);
hadgeneric:=false; hadgeneric:=false;
end; end;
else else

6
compiler/symcreat.pas
View File

@ -233,6 +233,7 @@ implementation
var var
oldparse_only: boolean; oldparse_only: boolean;
tmpstr: ansistring; tmpstr: ansistring;
flags : tread_proc_flags;
begin begin
if ((status.verbosity and v_debug)<>0) then if ((status.verbosity and v_debug)<>0) then
begin begin
@ -256,7 +257,10 @@ implementation
current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno); current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno);
current_scanner.readtoken(false); current_scanner.readtoken(false);
{ and parse it... } { 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; parse_only:=oldparse_only;
{ remove the temporary macro input file again } { remove the temporary macro input file again }
current_scanner.closeinputfile; current_scanner.closeinputfile;