* apply patch by Blaise.ru:

- avoid creation of a dummy typesym just to call parse_var_proc_directives() by introducing a new parse_proctype_directives() that takes a tprocvardef instead of a symbol like the former does
  - have parse_var_proc_directives() call parse_proctype_directives() to avoid duplicated code
This commit is contained in:
Sven/Sarah Barth 2022-01-06 18:04:32 +01:00
parent 542c3f0c4c
commit 0bbfad1add
3 changed files with 20 additions and 33 deletions

View File

@ -69,6 +69,7 @@ interface
procedure parse_parameter_dec(pd:tabstractprocdef); procedure parse_parameter_dec(pd:tabstractprocdef);
procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags); procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags);
procedure parse_var_proc_directives(sym:tsym); procedure parse_var_proc_directives(sym:tsym);
procedure parse_proctype_directives(pd:tprocvardef);
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;flags:tparse_proc_flags;genericdef:tdef;generictypelist:tfphashobjectlist;out pd:tprocdef):boolean; function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;flags:tparse_proc_flags;genericdef:tdef;generictypelist:tfphashobjectlist;out pd:tprocdef):boolean;
@ -218,7 +219,6 @@ implementation
parseprocvar : tppv; parseprocvar : tppv;
locationstr : string; locationstr : string;
paranr : integer; paranr : integer;
dummytype : ttypesym;
explicit_paraloc, explicit_paraloc,
need_array, need_array,
is_univ: boolean; is_univ: boolean;
@ -352,22 +352,16 @@ implementation
single_type(pv.returndef,[]); single_type(pv.returndef,[]);
block_type:=bt_var; block_type:=bt_var;
end; end;
hdef:=pv;
{ possible proc directives } { possible proc directives }
if check_proc_directive(true) then if check_proc_directive(true) then
begin parse_proctype_directives(pv);
dummytype:=ctypesym.create('unnamed',hdef);
parse_var_proc_directives(tsym(dummytype));
dummytype.typedef:=nil;
hdef.typesym:=nil;
dummytype.free;
end;
{ Add implicit hidden parameters and function result } { Add implicit hidden parameters and function result }
handle_calling_convention(pv,hcc_default_actions_intf); handle_calling_convention(pv,hcc_default_actions_intf);
{$ifdef jvm} {$ifdef jvm}
{ anonymous -> no name } { anonymous -> no name }
jvm_create_procvar_class('',pv); jvm_create_procvar_class('',pv);
{$endif} {$endif}
hdef:=pv;
end end
else else
{ read type declaration, force reading for value paras } { read type declaration, force reading for value paras }
@ -3440,25 +3434,30 @@ const
procedure parse_var_proc_directives(sym:tsym); procedure parse_var_proc_directives(sym:tsym);
var var
pdflags : tpdflags; pd : tprocvardef;
pd : tabstractprocdef;
begin begin
pdflags:=[pd_procvar];
pd:=nil;
case sym.typ of case sym.typ of
fieldvarsym, fieldvarsym,
staticvarsym, staticvarsym,
localvarsym, localvarsym,
paravarsym : paravarsym :
pd:=tabstractprocdef(tabstractvarsym(sym).vardef); pd:=tprocvardef(tabstractvarsym(sym).vardef);
typesym : typesym :
pd:=tabstractprocdef(ttypesym(sym).typedef); pd:=tprocvardef(ttypesym(sym).typedef);
else else
internalerror(2003042617); internalerror(2003042617);
end; end;
if pd.typ<>procvardef then if pd.typ<>procvardef then
internalerror(2003042618); internalerror(2003042618);
{ names should never be used anyway } parse_proctype_directives(pd);
end;
procedure parse_proctype_directives(pd:tprocvardef);
var
pdflags : tpdflags;
begin
pdflags:=[pd_procvar];
parse_proc_directives(pd,pdflags); parse_proc_directives(pd,pdflags);
end; end;

View File

@ -886,8 +886,6 @@ implementation
function maybe_parse_proc_directives(def:tdef):boolean; function maybe_parse_proc_directives(def:tdef):boolean;
var
newtype : ttypesym;
begin begin
result:=false; result:=false;
{ Process procvar directives before = and ; } { Process procvar directives before = and ; }
@ -895,11 +893,7 @@ implementation
(def.typesym=nil) and (def.typesym=nil) and
check_proc_directive(true) then check_proc_directive(true) then
begin begin
newtype:=ctypesym.create('unnamed',def); parse_proctype_directives(tprocvardef(def));
parse_var_proc_directives(tsym(newtype));
newtype.typedef:=nil;
def.typesym:=nil;
newtype.free;
result:=true; result:=true;
end; end;
end; end;

View File

@ -1565,8 +1565,7 @@ implementation
function procvar_dec(genericdef:tstoreddef;genericlist:tfphashobjectlist;doregister:boolean):tdef; function procvar_dec(genericdef:tstoreddef;genericlist:tfphashobjectlist;doregister:boolean):tdef;
var var
is_func:boolean; is_func:boolean;
pd:tabstractprocdef; pd:tprocvardef;
newtype:ttypesym;
old_current_genericdef, old_current_genericdef,
old_current_specializedef: tstoreddef; old_current_specializedef: tstoreddef;
old_parse_generic: boolean; old_parse_generic: boolean;
@ -1628,18 +1627,11 @@ implementation
end; end;
symtablestack.pop(pd.parast); symtablestack.pop(pd.parast);
tparasymtable(pd.parast).readonly:=false; tparasymtable(pd.parast).readonly:=false;
result:=pd;
{ possible proc directives } { possible proc directives }
if parseprocvardir then if parseprocvardir then
begin begin
if check_proc_directive(true) then if check_proc_directive(true) then
begin parse_proctype_directives(pd);
newtype:=ctypesym.create('unnamed',result);
parse_var_proc_directives(tsym(newtype));
newtype.typedef:=nil;
result.typesym:=nil;
newtype.free;
end;
{ Add implicit hidden parameters and function result } { Add implicit hidden parameters and function result }
handle_calling_convention(pd,hcc_default_actions_intf); handle_calling_convention(pd,hcc_default_actions_intf);
end; end;
@ -1647,6 +1639,8 @@ implementation
parse_generic:=old_parse_generic; parse_generic:=old_parse_generic;
current_genericdef:=old_current_genericdef; current_genericdef:=old_current_genericdef;
current_specializedef:=old_current_specializedef; current_specializedef:=old_current_specializedef;
result:=pd;
end; end;
const const