paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-13 11:24:14 +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
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 }

38
compiler/pdecsub.pas
View File

@ -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 }

38
compiler/psub.pas
View File

@ -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

6
compiler/symcreat.pas
View File

@ -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;