mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-15 14:19:28 +02:00
* symcreat functionality to use the parser from inside the compiler for
artificially generated stuff rather than directly working with defs/syms
problems
o scanner state saving/restoring, and avoiding problems in case of
errors in the injected strings
o in case of the actual application (adding overriding constructors):
the parameters may be of types not visible in the current unit to
newly written code -> can't just use the scanner...
git-svn-id: branches/jvmbackend@18427 -
This commit is contained in:
Jonas Maebe
parent
96b0ee0827
commit
019ca93a04
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -553,6 +553,7 @@ compiler/sparc/strinst.inc svneol=native#text/plain
|
||||
compiler/switches.pas svneol=native#text/plain
|
||||
compiler/symbase.pas svneol=native#text/plain
|
||||
compiler/symconst.pas svneol=native#text/plain
|
||||
compiler/symcreat.pas svneol=native#text/plain
|
||||
compiler/symdef.pas svneol=native#text/plain
|
||||
compiler/symnot.pas svneol=native#text/plain
|
||||
compiler/symsym.pas svneol=native#text/plain
|
||||
|
||||
@ -32,6 +32,9 @@ interface
|
||||
{ parses a object declaration }
|
||||
function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
|
||||
|
||||
{ parses a (class) method declaration }
|
||||
function method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
|
||||
|
||||
function class_constructor_head:tprocdef;
|
||||
function class_destructor_head:tprocdef;
|
||||
function constructor_head:tprocdef;
|
||||
@ -43,7 +46,7 @@ implementation
|
||||
uses
|
||||
sysutils,cutils,
|
||||
globals,verbose,systems,tokens,
|
||||
symbase,symsym,symtable,
|
||||
symbase,symsym,symtable,symcreat,
|
||||
node,nld,nmem,ncon,ncnv,ncal,
|
||||
fmodule,scanner,
|
||||
pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,ppu
|
||||
@ -704,7 +707,8 @@ implementation
|
||||
message(parser_e_dispinterface_needs_a_guid);
|
||||
end;
|
||||
|
||||
procedure parse_object_members;
|
||||
|
||||
function method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
|
||||
|
||||
procedure chkobjc(pd: tprocdef);
|
||||
begin
|
||||
@ -733,28 +737,195 @@ implementation
|
||||
{ nothing currently }
|
||||
end;
|
||||
|
||||
|
||||
procedure maybe_parse_hint_directives(pd:tprocdef);
|
||||
var
|
||||
dummysymoptions : tsymoptions;
|
||||
deprecatedmsg : pshortstring;
|
||||
begin
|
||||
dummysymoptions:=[];
|
||||
deprecatedmsg:=nil;
|
||||
while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
|
||||
Consume(_SEMICOLON);
|
||||
if assigned(pd) then
|
||||
begin
|
||||
pd.symoptions:=pd.symoptions+dummysymoptions;
|
||||
pd.deprecatedmsg:=deprecatedmsg;
|
||||
end
|
||||
else
|
||||
stringdispose(deprecatedmsg);
|
||||
end;
|
||||
var
|
||||
dummysymoptions : tsymoptions;
|
||||
deprecatedmsg : pshortstring;
|
||||
begin
|
||||
dummysymoptions:=[];
|
||||
deprecatedmsg:=nil;
|
||||
while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do
|
||||
Consume(_SEMICOLON);
|
||||
if assigned(pd) then
|
||||
begin
|
||||
pd.symoptions:=pd.symoptions+dummysymoptions;
|
||||
pd.deprecatedmsg:=deprecatedmsg;
|
||||
end
|
||||
else
|
||||
stringdispose(deprecatedmsg);
|
||||
end;
|
||||
|
||||
var
|
||||
oldparse_only: boolean;
|
||||
begin
|
||||
case token of
|
||||
_PROCEDURE,
|
||||
_FUNCTION:
|
||||
begin
|
||||
if (astruct.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in astruct.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
result:=parse_proc_dec(is_classdef,astruct);
|
||||
|
||||
{ this is for error recovery as well as forward }
|
||||
{ interface mappings, i.e. mapping to a method }
|
||||
{ which isn't declared yet }
|
||||
if assigned(result) then
|
||||
begin
|
||||
parse_object_proc_directives(result);
|
||||
|
||||
{ check if dispid is set }
|
||||
if is_dispinterface(result.struct) and not (po_dispid in result.procoptions) then
|
||||
begin
|
||||
result.dispid:=tobjectdef(result.struct).get_next_dispid;
|
||||
include(result.procoptions, po_dispid);
|
||||
end;
|
||||
|
||||
{ all Macintosh Object Pascal methods are virtual. }
|
||||
{ this can't be a class method, because macpas mode }
|
||||
{ has no m_class }
|
||||
if (m_mac in current_settings.modeswitches) then
|
||||
include(result.procoptions,po_virtualmethod);
|
||||
|
||||
{ for record helpers only static class methods are allowed }
|
||||
if is_objectpascal_helper(astruct) and
|
||||
is_record(tobjectdef(astruct).extendeddef) and
|
||||
is_classdef and not (po_staticmethod in result.procoptions) then
|
||||
MessagePos(result.fileinfo,parser_e_class_methods_only_static_in_records);
|
||||
|
||||
handle_calling_convention(result);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(result);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_msgint in result.procoptions) then
|
||||
include(astruct.objectoptions,oo_has_msgint);
|
||||
if (po_msgstr in result.procoptions) then
|
||||
include(astruct.objectoptions,oo_has_msgstr);
|
||||
if (po_virtualmethod in result.procoptions) then
|
||||
include(astruct.objectoptions,oo_has_virtual);
|
||||
|
||||
chkcpp(result);
|
||||
chkobjc(result);
|
||||
chkjava(result);
|
||||
end;
|
||||
|
||||
maybe_parse_hint_directives(result);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
end;
|
||||
_CONSTRUCTOR :
|
||||
begin
|
||||
if (astruct.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in astruct.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
if not is_classdef and not(astruct.symtable.currentvisibility in [vis_public,vis_published]) then
|
||||
Message(parser_w_constructor_should_be_public);
|
||||
|
||||
if is_interface(astruct) then
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ Objective-C does not know the concept of a constructor }
|
||||
if is_objc_class_or_protocol(astruct) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
if is_objectpascal_helper(astruct) then
|
||||
if is_classdef then
|
||||
{ class constructors are not allowed in class helpers }
|
||||
Message(parser_e_no_class_constructor_in_helpers)
|
||||
else if is_record(tobjectdef(astruct).extendeddef) then
|
||||
{ as long as constructors aren't allowed in records they
|
||||
aren't allowed in helpers either }
|
||||
Message(parser_e_no_constructor_in_records);
|
||||
|
||||
{ only 1 class constructor is allowed }
|
||||
if is_classdef and (oo_has_class_constructor in astruct.objectoptions) then
|
||||
Message1(parser_e_only_one_class_constructor_allowed, astruct.objrealname^);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
if is_classdef then
|
||||
result:=class_constructor_head
|
||||
else
|
||||
result:=constructor_head;
|
||||
parse_object_proc_directives(result);
|
||||
handle_calling_convention(result);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(result);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_virtualmethod in result.procoptions) then
|
||||
include(astruct.objectoptions,oo_has_virtual);
|
||||
chkcpp(result);
|
||||
maybe_parse_hint_directives(result);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
end;
|
||||
_DESTRUCTOR :
|
||||
begin
|
||||
if (astruct.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in astruct.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
if not is_classdef then
|
||||
if (oo_has_destructor in astruct.objectoptions) then
|
||||
Message(parser_n_only_one_destructor);
|
||||
|
||||
if is_interface(astruct) then
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ (class) destructors are not allowed in class helpers }
|
||||
if is_objectpascal_helper(astruct) then
|
||||
Message(parser_e_no_destructor_in_records);
|
||||
|
||||
if not is_classdef and (astruct.symtable.currentvisibility<>vis_public) then
|
||||
Message(parser_w_destructor_should_be_public);
|
||||
|
||||
{ Objective-C does not know the concept of a destructor }
|
||||
if is_objc_class_or_protocol(astruct) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
{ only 1 class destructor is allowed }
|
||||
if is_classdef and (oo_has_class_destructor in astruct.objectoptions) then
|
||||
Message1(parser_e_only_one_class_destructor_allowed, astruct.objrealname^);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
if is_classdef then
|
||||
result:=class_destructor_head
|
||||
else
|
||||
result:=destructor_head;
|
||||
parse_object_proc_directives(result);
|
||||
handle_calling_convention(result);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(result);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_virtualmethod in result.procoptions) then
|
||||
include(astruct.objectoptions,oo_has_virtual);
|
||||
|
||||
chkcpp(result);
|
||||
maybe_parse_hint_directives(result);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
end;
|
||||
else
|
||||
internalerror(2011032102);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure parse_object_members;
|
||||
|
||||
var
|
||||
pd : tprocdef;
|
||||
has_destructor,
|
||||
oldparse_only,
|
||||
typedconstswritable: boolean;
|
||||
object_member_blocktype : tblock_type;
|
||||
fields_allowed, is_classdef, class_fields, is_final, final_fields: boolean;
|
||||
@ -846,7 +1017,6 @@ implementation
|
||||
current_structdef.symtable.currentvisibility:=vis_published
|
||||
else
|
||||
current_structdef.symtable.currentvisibility:=vis_public;
|
||||
has_destructor:=false;
|
||||
fields_allowed:=true;
|
||||
is_classdef:=false;
|
||||
class_fields:=false;
|
||||
@ -1003,168 +1173,11 @@ implementation
|
||||
parse_class;
|
||||
end;
|
||||
_PROCEDURE,
|
||||
_FUNCTION:
|
||||
begin
|
||||
if (current_structdef.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in current_structdef.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
pd:=parse_proc_dec(is_classdef,current_structdef);
|
||||
|
||||
{ this is for error recovery as well as forward }
|
||||
{ interface mappings, i.e. mapping to a method }
|
||||
{ which isn't declared yet }
|
||||
if assigned(pd) then
|
||||
begin
|
||||
parse_object_proc_directives(pd);
|
||||
|
||||
{ check if dispid is set }
|
||||
if is_dispinterface(pd.struct) and not (po_dispid in pd.procoptions) then
|
||||
begin
|
||||
pd.dispid:=tobjectdef(pd.struct).get_next_dispid;
|
||||
include(pd.procoptions, po_dispid);
|
||||
end;
|
||||
|
||||
{ all Macintosh Object Pascal methods are virtual. }
|
||||
{ this can't be a class method, because macpas mode }
|
||||
{ has no m_class }
|
||||
if (m_mac in current_settings.modeswitches) then
|
||||
include(pd.procoptions,po_virtualmethod);
|
||||
|
||||
{ for record helpers only static class methods are allowed }
|
||||
if is_objectpascal_helper(current_structdef) and
|
||||
is_record(current_objectdef.extendeddef) and
|
||||
is_classdef and not (po_staticmethod in pd.procoptions) then
|
||||
MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
|
||||
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_msgint in pd.procoptions) then
|
||||
include(current_structdef.objectoptions,oo_has_msgint);
|
||||
if (po_msgstr in pd.procoptions) then
|
||||
include(current_structdef.objectoptions,oo_has_msgstr);
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(current_structdef.objectoptions,oo_has_virtual);
|
||||
|
||||
chkcpp(pd);
|
||||
chkobjc(pd);
|
||||
chkjava(pd);
|
||||
end;
|
||||
|
||||
maybe_parse_hint_directives(pd);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
_CONSTRUCTOR :
|
||||
begin
|
||||
if (current_structdef.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in current_structdef.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
if not is_classdef and not(current_structdef.symtable.currentvisibility in [vis_public,vis_published]) then
|
||||
Message(parser_w_constructor_should_be_public);
|
||||
|
||||
if is_interface(current_structdef) then
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ Objective-C does not know the concept of a constructor }
|
||||
if is_objc_class_or_protocol(current_structdef) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
if is_objectpascal_helper(current_structdef) then
|
||||
if is_classdef then
|
||||
{ class constructors are not allowed in class helpers }
|
||||
Message(parser_e_no_class_constructor_in_helpers)
|
||||
else
|
||||
if is_record(current_objectdef.extendeddef) then
|
||||
{ as long as constructors aren't allowed in records they
|
||||
aren't allowed in helpers either }
|
||||
Message(parser_e_no_constructor_in_records);
|
||||
|
||||
{ only 1 class constructor is allowed }
|
||||
if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then
|
||||
Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
if is_classdef then
|
||||
pd:=class_constructor_head
|
||||
else
|
||||
pd:=constructor_head;
|
||||
parse_object_proc_directives(pd);
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(current_structdef.objectoptions,oo_has_virtual);
|
||||
chkcpp(pd);
|
||||
maybe_parse_hint_directives(pd);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
_FUNCTION,
|
||||
_CONSTRUCTOR,
|
||||
_DESTRUCTOR :
|
||||
begin
|
||||
if (current_structdef.symtable.currentvisibility=vis_published) and
|
||||
not(oo_can_have_published in current_structdef.objectoptions) then
|
||||
Message(parser_e_cant_have_published);
|
||||
|
||||
if not is_classdef then
|
||||
if has_destructor then
|
||||
Message(parser_n_only_one_destructor)
|
||||
else
|
||||
has_destructor:=true;
|
||||
|
||||
if is_interface(current_structdef) then
|
||||
Message(parser_e_no_con_des_in_interfaces);
|
||||
|
||||
{ (class) destructors are not allowed in class helpers }
|
||||
if is_objectpascal_helper(current_structdef) then
|
||||
Message(parser_e_no_destructor_in_records);
|
||||
|
||||
if not is_classdef and (current_structdef.symtable.currentvisibility<>vis_public) then
|
||||
Message(parser_w_destructor_should_be_public);
|
||||
|
||||
{ Objective-C does not know the concept of a destructor }
|
||||
if is_objc_class_or_protocol(current_structdef) then
|
||||
Message(parser_e_objc_no_constructor_destructor);
|
||||
|
||||
{ only 1 class destructor is allowed }
|
||||
if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then
|
||||
Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^);
|
||||
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=true;
|
||||
if is_classdef then
|
||||
pd:=class_destructor_head
|
||||
else
|
||||
pd:=destructor_head;
|
||||
parse_object_proc_directives(pd);
|
||||
handle_calling_convention(pd);
|
||||
|
||||
{ add definition to procsym }
|
||||
proc_add_definition(pd);
|
||||
|
||||
{ add procdef options to objectdef options }
|
||||
if (po_virtualmethod in pd.procoptions) then
|
||||
include(current_structdef.objectoptions,oo_has_virtual);
|
||||
|
||||
chkcpp(pd);
|
||||
maybe_parse_hint_directives(pd);
|
||||
|
||||
parse_only:=oldparse_only;
|
||||
method_dec(current_structdef,is_classdef);
|
||||
fields_allowed:=false;
|
||||
is_classdef:=false;
|
||||
end;
|
||||
@ -1330,6 +1343,15 @@ implementation
|
||||
|
||||
{ parse and insert object members }
|
||||
parse_object_members;
|
||||
|
||||
{ In Java, constructors are not automatically inherited (so you can
|
||||
hide them). Emulate the Pascal behaviour for classes implemented
|
||||
in Pascal (we cannot do it for classes implemented in Java, since
|
||||
we obviously cannot add constructors to those) }
|
||||
if is_javaclass(current_structdef) and
|
||||
not(oo_is_external in current_structdef.objectoptions) then
|
||||
add_missing_parent_constructors_intf(tobjectdef(current_structdef));
|
||||
|
||||
symtablestack.pop(current_structdef.symtable);
|
||||
end;
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@ implementation
|
||||
globtype,version,systems,tokens,
|
||||
cutils,cfileutl,cclasses,comphook,
|
||||
globals,verbose,fmodule,finput,fppu,
|
||||
symconst,symbase,symtype,symdef,symsym,symtable,
|
||||
symconst,symbase,symtype,symdef,symsym,symtable,symcreat,
|
||||
wpoinfo,
|
||||
aasmtai,aasmdata,aasmcpu,aasmbase,
|
||||
cgbase,cgobj,
|
||||
@ -1041,6 +1041,7 @@ implementation
|
||||
until false;
|
||||
end;
|
||||
|
||||
|
||||
procedure proc_unit;
|
||||
|
||||
function is_assembler_generated:boolean;
|
||||
@ -1267,6 +1268,10 @@ implementation
|
||||
init_procinfo.parse_body;
|
||||
{ save file pos for debuginfo }
|
||||
current_module.mainfilepos:=init_procinfo.entrypos;
|
||||
{ add implementations for synthetic method declarations added by
|
||||
the compiler }
|
||||
add_synthetic_method_implementations(current_module.globalsymtable);
|
||||
add_synthetic_method_implementations(current_module.localsymtable);
|
||||
end;
|
||||
|
||||
{ Generate specializations of objectdefs methods }
|
||||
|
||||
@ -66,6 +66,11 @@ interface
|
||||
{ reads declarations in the interface part of a unit }
|
||||
procedure read_interface_declarations;
|
||||
|
||||
{ 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);
|
||||
|
||||
procedure generate_specialization_procs;
|
||||
|
||||
|
||||
@ -81,7 +86,7 @@ implementation
|
||||
{ aasm }
|
||||
cpuinfo,cpubase,aasmbase,aasmtai,aasmdata,
|
||||
{ symtable }
|
||||
symconst,symbase,symsym,symtype,symtable,defutil,
|
||||
symconst,symbase,symsym,symtype,symtable,defutil,symcreat,
|
||||
paramgr,
|
||||
ppu,fmodule,
|
||||
{ pass 1 }
|
||||
@ -1946,6 +1951,10 @@ implementation
|
||||
end;
|
||||
until false;
|
||||
|
||||
{ add implementations for synthetic method declarations added by
|
||||
the compiler }
|
||||
add_synthetic_method_implementations(current_procinfo.procdef.localst);
|
||||
|
||||
{ check for incomplete class definitions, this is only required
|
||||
for fpc modes }
|
||||
if (m_fpc in current_settings.modeswitches) then
|
||||
|
||||
@ -78,8 +78,14 @@ interface
|
||||
|
||||
tspecialgenerictoken = (ST_LOADSETTINGS,ST_LINE,ST_COLUMN,ST_FILEINDEX);
|
||||
|
||||
{ tscannerfile }
|
||||
tscannerstate = record
|
||||
lasttokenpos: longint;
|
||||
current_tokenpos,
|
||||
current_filepos: tfileposinfo;
|
||||
token: ttoken;
|
||||
end;
|
||||
|
||||
{ tscannerfile }
|
||||
tscannerfile = class
|
||||
private
|
||||
procedure do_gettokenpos(out tokenpos: longint; out filepos: tfileposinfo);
|
||||
@ -145,7 +151,12 @@ interface
|
||||
procedure nextfile;
|
||||
procedure addfile(hp:tinputfile);
|
||||
procedure reload;
|
||||
procedure insertmacro(const macname:string;p:pchar;len,line,fileindex:longint);
|
||||
{ replaces current token with the text in p }
|
||||
procedure substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint);
|
||||
{ inserts the text in p before the current token; the current token
|
||||
will be restored afterwards }
|
||||
procedure inserttext_begin(const macname: string; const str: ansistring; out scannerstate: tscannerstate);
|
||||
procedure inserttext_end(const scannerstate: tscannerstate);
|
||||
{ Scanner things }
|
||||
procedure gettokenpos;
|
||||
procedure inc_comment_level;
|
||||
@ -1753,7 +1764,7 @@ In case not, the value returned can be arbitrary.
|
||||
Message1(scan_w_include_env_not_found,path);
|
||||
{ make it a stringconst }
|
||||
hs:=''''+hs+'''';
|
||||
current_scanner.insertmacro(path,@hs[1],length(hs),
|
||||
current_scanner.substitutemacro(path,@hs[1],length(hs),
|
||||
current_scanner.line_no,current_scanner.inputfile.ref_index);
|
||||
end
|
||||
else
|
||||
@ -2423,7 +2434,7 @@ In case not, the value returned can be arbitrary.
|
||||
end;
|
||||
|
||||
|
||||
procedure tscannerfile.insertmacro(const macname:string;p:pchar;len,line,fileindex:longint);
|
||||
procedure tscannerfile.substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint);
|
||||
var
|
||||
hp : tinputfile;
|
||||
begin
|
||||
@ -2454,6 +2465,35 @@ In case not, the value returned can be arbitrary.
|
||||
end;
|
||||
|
||||
|
||||
procedure tscannerfile.inserttext_begin(const macname: string; const str: ansistring; out scannerstate: tscannerstate);
|
||||
begin
|
||||
if (nexttoken<>NOTOKEN) then
|
||||
internalerror(2011032103);
|
||||
scannerstate.lasttokenpos:=lasttokenpos;
|
||||
scannerstate.token:=token;
|
||||
scannerstate.current_tokenpos:=current_tokenpos;
|
||||
scannerstate.current_filepos:=current_filepos;
|
||||
|
||||
current_scanner.substitutemacro(macname,@str[1],length(str),
|
||||
current_scanner.line_no,current_scanner.inputfile.ref_index);
|
||||
current_scanner.readtoken(false);
|
||||
end;
|
||||
|
||||
|
||||
procedure tscannerfile.inserttext_end(const scannerstate: tscannerstate);
|
||||
begin
|
||||
if nexttoken<>NOTOKEN then
|
||||
internalerror(2011032104);
|
||||
nexttoken:=token;
|
||||
cachenexttokenpos;
|
||||
|
||||
lasttokenpos:=scannerstate.lasttokenpos;
|
||||
token:=scannerstate.token;
|
||||
current_tokenpos:=scannerstate.current_tokenpos;
|
||||
current_filepos:=scannerstate.current_filepos;
|
||||
end;
|
||||
|
||||
|
||||
procedure tscannerfile.do_gettokenpos(out tokenpos: longint; out filepos: tfileposinfo);
|
||||
begin
|
||||
tokenpos:=inputstart+(inputpointer-inputbuffer);
|
||||
@ -3539,7 +3579,7 @@ In case not, the value returned can be arbitrary.
|
||||
begin
|
||||
mac.is_used:=true;
|
||||
inc(yylexcount);
|
||||
insertmacro(pattern,mac.buftext,mac.buflen,
|
||||
substitutemacro(pattern,mac.buftext,mac.buflen,
|
||||
mac.fileinfo.line,mac.fileinfo.fileindex);
|
||||
{ handle empty macros }
|
||||
if c=#0 then
|
||||
|
||||
@ -316,7 +316,9 @@ type
|
||||
up the stack will also remain balanced) }
|
||||
po_delphi_nested_cc,
|
||||
{ Java method }
|
||||
po_java
|
||||
po_java,
|
||||
{ synthetic method, not parsed from source but inserted by compiler }
|
||||
po_synthetic
|
||||
);
|
||||
tprocoptions=set of tprocoption;
|
||||
|
||||
|
||||
215
compiler/symcreat.pas
Normal file
215
compiler/symcreat.pas
Normal file
@ -0,0 +1,215 @@
|
||||
{
|
||||
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,
|
||||
symconst,symdef,symbase;
|
||||
|
||||
{ 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);
|
||||
procedure add_missing_parent_constructors_impl(obj: tobjectdef);
|
||||
|
||||
{ parses a (class or regular) method/constructor/destructor declaration from
|
||||
str, as if it were declared in astruct's declaration body }
|
||||
function str_parse_method_dec(str: ansistring; 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 }
|
||||
function str_parse_method_impl(str: ansistring; is_classdef: boolean):boolean;
|
||||
|
||||
{ goes through all defs in st to add implementations for synthetic methods
|
||||
added earlier }
|
||||
procedure add_synthetic_method_implementations(st: tsymtable);
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
verbose,systems,
|
||||
tokens,scanner,
|
||||
symtype,symsym,symtable,
|
||||
pbase,pdecobj,psub,
|
||||
defcmp;
|
||||
|
||||
|
||||
function str_parse_method_dec(str: ansistring; is_classdef: boolean; astruct: tabstractrecorddef; out pd: tprocdef): boolean;
|
||||
var
|
||||
oldparse_only: boolean;
|
||||
scannerstate: tscannerstate;
|
||||
begin
|
||||
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... }
|
||||
pd:=method_dec(astruct,is_classdef);
|
||||
if assigned(pd) then
|
||||
begin
|
||||
include(pd.procoptions,po_synthetic);
|
||||
result:=true;
|
||||
end;
|
||||
parse_only:=oldparse_only;
|
||||
// current_scanner.inserttext_end(scannerstate);
|
||||
end;
|
||||
|
||||
|
||||
function str_parse_method_impl(str: ansistring; is_classdef: boolean):boolean;
|
||||
var
|
||||
oldparse_only: boolean;
|
||||
scannerstate: tscannerstate;
|
||||
begin
|
||||
str:=str+'end;';
|
||||
(*
|
||||
oldparse_only:=parse_only;
|
||||
parse_only:=false;
|
||||
{ inject the string in the scanner }
|
||||
current_scanner.inserttext_begin('meth_impl_macro',str,scannerstate);
|
||||
dec(current_scanner.yylexcount);
|
||||
read_proc(is_classdef);
|
||||
parse_only:=oldparse_only;
|
||||
result:=true;
|
||||
current_scanner.inserttext_end(scannerstate);
|
||||
*)
|
||||
end;
|
||||
|
||||
|
||||
procedure add_missing_parent_constructors_intf(obj: tobjectdef);
|
||||
var
|
||||
parent: tobjectdef;
|
||||
psym: tprocsym;
|
||||
def: tdef;
|
||||
pd: tprocdef;
|
||||
newpd,
|
||||
parentpd: tprocdef;
|
||||
i: longint;
|
||||
srsym: tsym;
|
||||
srsymtable: tsymtable;
|
||||
isclassmethod: boolean;
|
||||
str: ansistring;
|
||||
old_scanner: tscannerfile;
|
||||
begin
|
||||
if not assigned(obj.childof) then
|
||||
exit;
|
||||
old_scanner:=nil;
|
||||
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) then
|
||||
continue;
|
||||
pd:=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,pd.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
|
||||
parentpd:=tprocsym(srsym).find_procdef_bytype_and_para(
|
||||
potype_constructor,pd.paras,tprocdef(def).returndef,
|
||||
[cpo_ignorehidden,cpo_ignoreuniv,cpo_openequalisexact]);
|
||||
if assigned(parentpd) then
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
{ if we get here, we did not find it in the current objectdef ->
|
||||
add }
|
||||
if not assigned(old_scanner) then
|
||||
begin
|
||||
old_scanner:=current_scanner;
|
||||
current_scanner:=tscannerfile.Create('_Macro_.parent_constructors_intf');
|
||||
end;
|
||||
isclassmethod:=
|
||||
(po_classmethod in tprocdef(pd).procoptions) and
|
||||
not(tprocdef(pd).proctypeoption in [potype_constructor,potype_destructor]);
|
||||
{ + 'overload' for Delphi modes }
|
||||
str:=tprocdef(pd).customprocname([pno_proctypeoption,pno_paranames,pno_noclassmarker])+'overload;';
|
||||
if not str_parse_method_dec(str,isclassmethod,obj,newpd) then
|
||||
internalerror(2011032001);
|
||||
include(newpd.procoptions,po_synthetic);
|
||||
end;
|
||||
if assigned(old_scanner) then
|
||||
begin
|
||||
current_scanner.free;
|
||||
current_scanner:=old_scanner;
|
||||
current_scanner.readtoken(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure add_missing_parent_constructors_impl(obj: tobjectdef);
|
||||
var
|
||||
i: longint;
|
||||
def: tdef;
|
||||
str: ansistring;
|
||||
isclassmethod: boolean;
|
||||
begin
|
||||
for i:=0 to tobjectsymtable(obj.symtable).deflist.count-1 do
|
||||
begin
|
||||
def:=tdef(tobjectsymtable(obj.symtable).deflist[i]);
|
||||
if (def.typ<>procdef) or
|
||||
not(po_synthetic in tprocdef(def).procoptions) then
|
||||
continue;
|
||||
isclassmethod:=
|
||||
(po_classmethod in tprocdef(def).procoptions) and
|
||||
not(tprocdef(def).proctypeoption in [potype_constructor,potype_destructor]);
|
||||
str:=tprocdef(def).customprocname([pno_proctypeoption,pno_paranames,pno_ownername,pno_noclassmarker]);
|
||||
str:=str+'overload; begin inherited end;';
|
||||
str_parse_method_impl(str,isclassmethod);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure add_synthetic_method_implementations(st: tsymtable);
|
||||
var
|
||||
i: longint;
|
||||
def: tdef;
|
||||
begin
|
||||
{ only necessary for the JVM target currently }
|
||||
if not (target_info.system in [system_jvm_java32]) then
|
||||
exit;
|
||||
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) then
|
||||
add_missing_parent_constructors_impl(tobjectdef(def));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -3338,7 +3338,7 @@ implementation
|
||||
first:=false;
|
||||
end
|
||||
else
|
||||
s:=s+',';
|
||||
s:=s+';';
|
||||
if vo_is_hidden_para in hp.varoptions then
|
||||
s:=s+'<';
|
||||
case hp.varspez of
|
||||
|
||||
@ -102,6 +102,7 @@ interface
|
||||
procedure deref;override;
|
||||
function find_procdef_bytype(pt:Tproctypeoption):Tprocdef;
|
||||
function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
|
||||
function find_procdef_bytype_and_para(pt:Tproctypeoption;para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
|
||||
function find_procdef_byoptions(ops:tprocoptions): Tprocdef;
|
||||
function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
|
||||
function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
|
||||
@ -652,35 +653,67 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function check_procdef_paras(pd:tprocdef;para:TFPObjectList;retdef:tdef;
|
||||
cpoptions:tcompare_paras_options): tprocdef;
|
||||
var
|
||||
eq: tequaltype;
|
||||
begin
|
||||
result:=nil;
|
||||
if assigned(retdef) then
|
||||
eq:=compare_defs(retdef,pd.returndef,nothingn)
|
||||
else
|
||||
eq:=te_equal;
|
||||
if (eq>=te_equal) or
|
||||
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
|
||||
begin
|
||||
eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions);
|
||||
if (eq>=te_equal) or
|
||||
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
|
||||
begin
|
||||
result:=pd;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function Tprocsym.Find_procdef_bypara(para:TFPObjectList;retdef:tdef;
|
||||
cpoptions:tcompare_paras_options):Tprocdef;
|
||||
var
|
||||
i : longint;
|
||||
pd : tprocdef;
|
||||
eq : tequaltype;
|
||||
begin
|
||||
result:=nil;
|
||||
for i:=0 to ProcdefList.Count-1 do
|
||||
begin
|
||||
pd:=tprocdef(ProcdefList[i]);
|
||||
if assigned(retdef) then
|
||||
eq:=compare_defs(retdef,pd.returndef,nothingn)
|
||||
else
|
||||
eq:=te_equal;
|
||||
if (eq>=te_equal) or
|
||||
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
|
||||
result:=check_procdef_paras(pd,para,retdef,cpoptions);
|
||||
if assigned(result) then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function Tprocsym.find_procdef_bytype_and_para(pt:Tproctypeoption;
|
||||
para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
|
||||
var
|
||||
i : longint;
|
||||
pd : tprocdef;
|
||||
begin
|
||||
result:=nil;
|
||||
for i:=0 to ProcdefList.Count-1 do
|
||||
begin
|
||||
pd:=tprocdef(ProcdefList[i]);
|
||||
if pd.proctypeoption=pt then
|
||||
begin
|
||||
eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions);
|
||||
if (eq>=te_equal) or
|
||||
((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then
|
||||
begin
|
||||
result:=pd;
|
||||
exit;
|
||||
end;
|
||||
result:=check_procdef_paras(pd,para,retdef,cpoptions);
|
||||
if assigned(result) then
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function tprocsym.find_procdef_byoptions(ops: tprocoptions): Tprocdef;
|
||||
var
|
||||
i : longint;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user