mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-01 22:53:42 +02:00
f27ebf8b6d
current class, since constructors are not automatically inherited in
Java
o tprocdef.getcopy() implementation, which returns an (unfinished) copy
of a tprocdef. Finalise by calling symcreat.finish_copied_procdef()
o made it possible to specify an existing procdef as argument to
read_proc(), in which case it won't try to parse a procedure declaration,
but only a body and associate it with the passed procdef. This is
required for the inherited constructor support, since we cannot generate
a textual representation of inherited constructors that is guaranteed to
parse in the context of the current unit (e.g., if they use types from
a unit that is not in the uses clause of the current unit)
o folded tprocsym.find_procdef_bypara_no_rettype() into
Tprocsym.Find_procdef_bypara, by interpreting specifying nil as
retdef as not having to check the return def (required to compare
parent constructors with child constructors to see whether they
match, since the returndef will always be the current class type)
git-svn-id: branches/jvmbackend@18488 -
432 lines
14 KiB
ObjectPascal
432 lines
14 KiB
ObjectPascal
{
|
|
Copyright (c) 2011 by Jonas Maebe
|
|
|
|
This unit provides helpers for creating new syms/defs based on string
|
|
representations.
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
{$i fpcdefs.inc}
|
|
|
|
unit symcreat;
|
|
|
|
interface
|
|
|
|
uses
|
|
finput,tokens,scanner,
|
|
symconst,symdef,symbase;
|
|
|
|
|
|
type
|
|
tscannerstate = record
|
|
old_scanner: tscannerfile;
|
|
old_token: ttoken;
|
|
old_c: char;
|
|
valid: boolean;
|
|
end;
|
|
|
|
{ save/restore the scanner state before/after injecting }
|
|
procedure replace_scanner(const tempname: string; out sstate: tscannerstate);
|
|
procedure restore_scanner(const sstate: tscannerstate);
|
|
|
|
{ parses a (class or regular) method/constructor/destructor declaration from
|
|
str, as if it were declared in astruct's declaration body
|
|
|
|
WARNING: save the scanner state before calling this routine, and restore
|
|
when done. }
|
|
function str_parse_method_dec(str: ansistring; potype: tproctypeoption; is_classdef: boolean; astruct: tabstractrecorddef; out pd: tprocdef): boolean;
|
|
|
|
{ parses a (class or regular) method/constructor/destructor implementation
|
|
from str, as if it appeared in the current unit's implementation section
|
|
|
|
WARNING: save the scanner state before calling this routine, and restore
|
|
when done. }
|
|
function str_parse_method_impl(str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
|
|
|
|
|
|
{ in the JVM, constructors are not automatically inherited (so you can hide
|
|
them). To emulate the Pascal behaviour, we have to automatically add
|
|
all parent constructors to the current class as well.}
|
|
procedure add_missing_parent_constructors_intf(obj: tobjectdef);
|
|
|
|
{ goes through all defs in st to add implementations for synthetic methods
|
|
added earlier }
|
|
procedure add_synthetic_method_implementations(st: tsymtable);
|
|
|
|
|
|
procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
cutils,verbose,systems,comphook,
|
|
symtype,symsym,symtable,defutil,
|
|
pbase,pdecobj,pdecsub,psub,
|
|
defcmp;
|
|
|
|
procedure replace_scanner(const tempname: string; out sstate: tscannerstate);
|
|
begin
|
|
{ would require saving of idtoken, pattern etc }
|
|
if (token=_ID) then
|
|
internalerror(2011032201);
|
|
sstate.old_scanner:=current_scanner;
|
|
sstate.old_token:=token;
|
|
sstate.old_c:=c;
|
|
sstate.valid:=true;
|
|
current_scanner:=tscannerfile.Create('_Macro_.'+tempname);
|
|
end;
|
|
|
|
|
|
procedure restore_scanner(const sstate: tscannerstate);
|
|
begin
|
|
if sstate.valid then
|
|
begin
|
|
current_scanner.free;
|
|
current_scanner:=sstate.old_scanner;
|
|
token:=sstate.old_token;
|
|
c:=sstate.old_c;
|
|
end;
|
|
end;
|
|
|
|
|
|
function str_parse_method_dec(str: ansistring; potype: tproctypeoption; is_classdef: boolean; astruct: tabstractrecorddef; out pd: tprocdef): boolean;
|
|
var
|
|
oldparse_only: boolean;
|
|
begin
|
|
Message1(parser_d_internal_parser_string,str);
|
|
oldparse_only:=parse_only;
|
|
parse_only:=true;
|
|
result:=false;
|
|
{ inject the string in the scanner }
|
|
str:=str+'end;';
|
|
current_scanner.substitutemacro('meth_head_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
|
|
current_scanner.readtoken(false);
|
|
{ and parse it... }
|
|
case potype of
|
|
potype_class_constructor:
|
|
pd:=class_constructor_head(astruct);
|
|
potype_class_destructor:
|
|
pd:=class_destructor_head(astruct);
|
|
potype_constructor:
|
|
pd:=constructor_head;
|
|
potype_destructor:
|
|
pd:=destructor_head;
|
|
else
|
|
pd:=method_dec(astruct,is_classdef);
|
|
end;
|
|
if assigned(pd) then
|
|
result:=true;
|
|
parse_only:=oldparse_only;
|
|
end;
|
|
|
|
|
|
function str_parse_method_impl(str: ansistring; usefwpd: tprocdef; is_classdef: boolean):boolean;
|
|
var
|
|
oldparse_only: boolean;
|
|
tmpstr: ansistring;
|
|
begin
|
|
if ((status.verbosity and v_debug)<>0) then
|
|
begin
|
|
if assigned(usefwpd) then
|
|
Message1(parser_d_internal_parser_string,usefwpd.customprocname([pno_proctypeoption,pno_paranames,pno_noclassmarker,pno_noleadingdollar]))
|
|
else
|
|
begin
|
|
if is_classdef then
|
|
tmpstr:='class '
|
|
else
|
|
tmpstr:='';
|
|
Message1(parser_d_internal_parser_string,tmpstr+str);
|
|
end;
|
|
end;
|
|
oldparse_only:=parse_only;
|
|
parse_only:=false;
|
|
result:=false;
|
|
{ inject the string in the scanner }
|
|
str:=str+'end;';
|
|
current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
|
|
current_scanner.readtoken(false);
|
|
{ and parse it... }
|
|
read_proc(is_classdef,usefwpd);
|
|
parse_only:=oldparse_only;
|
|
result:=true;
|
|
end;
|
|
|
|
|
|
procedure add_missing_parent_constructors_intf(obj: tobjectdef);
|
|
var
|
|
parent: tobjectdef;
|
|
def: tdef;
|
|
parentpd,
|
|
childpd: tprocdef;
|
|
i: longint;
|
|
srsym: tsym;
|
|
srsymtable: tsymtable;
|
|
begin
|
|
if (oo_is_external in obj.objectoptions) or
|
|
not assigned(obj.childof) then
|
|
exit;
|
|
parent:=obj.childof;
|
|
{ find all constructor in the parent }
|
|
for i:=0 to tobjectsymtable(parent.symtable).deflist.count-1 do
|
|
begin
|
|
def:=tdef(tobjectsymtable(parent.symtable).deflist[i]);
|
|
if (def.typ<>procdef) or
|
|
(tprocdef(def).proctypeoption<>potype_constructor) or
|
|
not is_visible_for_object(tprocdef(def),obj) then
|
|
continue;
|
|
parentpd:=tprocdef(def);
|
|
{ do we have this constructor too? (don't use
|
|
search_struct_member/searchsym_in_class, since those will
|
|
search parents too) }
|
|
if searchsym_in_record(obj,parentpd.procsym.name,srsym,srsymtable) then
|
|
begin
|
|
{ there's a symbol with the same name, is it a constructor
|
|
with the same parameters? }
|
|
if srsym.typ=procsym then
|
|
begin
|
|
childpd:=tprocsym(srsym).find_procdef_bytype_and_para(
|
|
potype_constructor,parentpd.paras,nil,
|
|
[cpo_ignorehidden,cpo_ignoreuniv,cpo_openequalisexact]);
|
|
if assigned(childpd) then
|
|
continue;
|
|
end;
|
|
end;
|
|
{ if we get here, we did not find it in the current objectdef ->
|
|
add }
|
|
childpd:=tprocdef(parentpd.getcopy);
|
|
finish_copied_procdef(childpd,parentpd.procsym.realname,obj.symtable,obj);
|
|
exclude(childpd.procoptions,po_external);
|
|
include(childpd.procoptions,po_overload);
|
|
childpd.synthetickind:=tsk_anon_inherited;
|
|
include(obj.objectoptions,oo_has_constructor);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure implement_anon_inherited(pd: tprocdef);
|
|
var
|
|
str: ansistring;
|
|
isclassmethod: boolean;
|
|
begin
|
|
isclassmethod:=
|
|
(po_classmethod in pd.procoptions) and
|
|
not(pd.proctypeoption in [potype_constructor,potype_destructor]);
|
|
str:='begin inherited end;';
|
|
str_parse_method_impl(str,pd,isclassmethod);
|
|
end;
|
|
|
|
|
|
procedure implement_jvm_clone(pd: tprocdef);
|
|
var
|
|
struct: tabstractrecorddef;
|
|
str: ansistring;
|
|
i: longint;
|
|
sym: tsym;
|
|
fsym: tfieldvarsym;
|
|
begin
|
|
if not(pd.struct.typ in [recorddef,objectdef]) then
|
|
internalerror(2011032802);
|
|
struct:=pd.struct;
|
|
{ anonymous record types must get an artificial name, so we can generate
|
|
a typecast at the scanner level }
|
|
if (struct.typ=recorddef) and
|
|
not assigned(struct.typesym) then
|
|
internalerror(2011032812);
|
|
{ the inherited clone will already copy all fields in a shallow way ->
|
|
copy records/regular arrays in a regular way }
|
|
str:='begin clone:=inherited;';
|
|
for i:=0 to struct.symtable.symlist.count-1 do
|
|
begin
|
|
sym:=tsym(struct.symtable.symlist[i]);
|
|
if (sym.typ=fieldvarsym) then
|
|
begin
|
|
fsym:=tfieldvarsym(sym);
|
|
if (fsym.vardef.typ=recorddef) or
|
|
((fsym.vardef.typ=arraydef) and
|
|
not is_dynamic_array(fsym.vardef)) or
|
|
((fsym.vardef.typ=setdef) and
|
|
not is_smallset(fsym.vardef)) then
|
|
str:=str+struct.typesym.realname+'(clone).'+fsym.realname+':='+fsym.realname+';';
|
|
end;
|
|
end;
|
|
str:=str+'end;';
|
|
str_parse_method_impl(str,pd,false);
|
|
end;
|
|
|
|
|
|
procedure implement_record_deepcopy(pd: tprocdef);
|
|
var
|
|
struct: tabstractrecorddef;
|
|
str: ansistring;
|
|
i: longint;
|
|
sym: tsym;
|
|
fsym: tfieldvarsym;
|
|
begin
|
|
if not(pd.struct.typ in [recorddef,objectdef]) then
|
|
internalerror(2011032810);
|
|
struct:=pd.struct;
|
|
{ anonymous record types must get an artificial name, so we can generate
|
|
a typecast at the scanner level }
|
|
if (struct.typ=recorddef) and
|
|
not assigned(struct.typesym) then
|
|
internalerror(2011032811);
|
|
{ copy all fields }
|
|
str:='begin ';
|
|
for i:=0 to struct.symtable.symlist.count-1 do
|
|
begin
|
|
sym:=tsym(struct.symtable.symlist[i]);
|
|
if (sym.typ=fieldvarsym) then
|
|
begin
|
|
fsym:=tfieldvarsym(sym);
|
|
str:=str+'result.'+fsym.realname+':='+fsym.realname+';';
|
|
end;
|
|
end;
|
|
str:=str+'end;';
|
|
str_parse_method_impl(str,pd,false);
|
|
end;
|
|
|
|
|
|
procedure implement_empty(pd: tprocdef);
|
|
var
|
|
str: ansistring;
|
|
isclassmethod: boolean;
|
|
begin
|
|
isclassmethod:=
|
|
(po_classmethod in pd.procoptions) and
|
|
not(pd.proctypeoption in [potype_constructor,potype_destructor]);
|
|
str:='begin end;';
|
|
str_parse_method_impl(str,pd,isclassmethod);
|
|
end;
|
|
|
|
|
|
|
|
procedure add_synthetic_method_implementations_for_struct(struct: tabstractrecorddef);
|
|
var
|
|
i : longint;
|
|
def : tdef;
|
|
pd : tprocdef;
|
|
begin
|
|
for i:=0 to struct.symtable.deflist.count-1 do
|
|
begin
|
|
def:=tdef(struct.symtable.deflist[i]);
|
|
if (def.typ<>procdef) then
|
|
continue;
|
|
pd:=tprocdef(def);
|
|
case pd.synthetickind of
|
|
tsk_none:
|
|
;
|
|
tsk_anon_inherited:
|
|
implement_anon_inherited(pd);
|
|
tsk_jvm_clone:
|
|
implement_jvm_clone(pd);
|
|
tsk_record_deepcopy:
|
|
implement_record_deepcopy(pd);
|
|
tsk_empty,
|
|
{ special handling for this one is done in tnodeutils.wrap_proc_body }
|
|
tsk_tcinit:
|
|
implement_empty(pd);
|
|
else
|
|
internalerror(2011032801);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure add_synthetic_method_implementations(st: tsymtable);
|
|
var
|
|
i: longint;
|
|
def: tdef;
|
|
sstate: tscannerstate;
|
|
begin
|
|
{ only necessary for the JVM target currently }
|
|
if not (target_info.system in [system_jvm_java32]) then
|
|
exit;
|
|
sstate.valid:=false;
|
|
for i:=0 to st.deflist.count-1 do
|
|
begin
|
|
def:=tdef(st.deflist[i]);
|
|
if (is_javaclass(def) and
|
|
not(oo_is_external in tobjectdef(def).objectoptions)) or
|
|
(def.typ=recorddef) then
|
|
begin
|
|
if not sstate.valid then
|
|
replace_scanner('synthetic_impl',sstate);
|
|
add_synthetic_method_implementations_for_struct(tabstractrecorddef(def));
|
|
{ also complete nested types }
|
|
add_synthetic_method_implementations(tabstractrecorddef(def).symtable);
|
|
end;
|
|
end;
|
|
restore_scanner(sstate);
|
|
end;
|
|
|
|
|
|
procedure finish_copied_procdef(var pd: tprocdef; const realname: string; newparentst: tsymtable; newstruct: tabstractrecorddef);
|
|
var
|
|
sym: tsym;
|
|
parasym: tparavarsym;
|
|
ps: tprocsym;
|
|
hdef: tdef;
|
|
stname: string;
|
|
i: longint;
|
|
begin
|
|
{ associate the procdef with a procsym in the owner }
|
|
if not(pd.proctypeoption in [potype_class_constructor,potype_class_destructor]) then
|
|
stname:=upper(realname)
|
|
else
|
|
stname:=lower(realname);
|
|
sym:=tsym(newparentst.find(stname));
|
|
if assigned(sym) then
|
|
begin
|
|
if sym.typ<>procsym then
|
|
internalerror(2011040601);
|
|
ps:=tprocsym(sym);
|
|
end
|
|
else
|
|
begin
|
|
ps:=tprocsym.create(realname);
|
|
newparentst.insert(ps);
|
|
end;
|
|
pd.procsym:=ps;
|
|
pd.struct:=newstruct;
|
|
{ in case of methods, replace the special parameter types with new ones }
|
|
if assigned(newstruct) then
|
|
begin
|
|
symtablestack.push(pd.parast);
|
|
for i:=0 to pd.paras.count-1 do
|
|
begin
|
|
parasym:=tparavarsym(pd.paras[i]);
|
|
if vo_is_self in parasym.varoptions then
|
|
begin
|
|
if parasym.vardef.typ=classrefdef then
|
|
parasym.vardef:=tclassrefdef.create(newstruct)
|
|
else
|
|
parasym.vardef:=newstruct;
|
|
end
|
|
end;
|
|
{ also fix returndef in case of a constructor }
|
|
if pd.proctypeoption=potype_constructor then
|
|
pd.returndef:=newstruct;
|
|
symtablestack.pop(pd.parast);
|
|
end;
|
|
proc_add_definition(pd);
|
|
end;
|
|
|
|
|
|
end.
|
|
|