diff --git a/.gitattributes b/.gitattributes index 2f44f6e403..666ab9e80b 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index c1f6e20da8..6e03e6335b 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -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; diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 6afffede95..8e4b041ed5 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -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 } diff --git a/compiler/psub.pas b/compiler/psub.pas index 187fb6158b..4608617f78 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 04fb24469d..dc446a5f42 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -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 diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 89f7991f79..359046eaee 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -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; diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas new file mode 100644 index 0000000000..fab2c9b49f --- /dev/null +++ b/compiler/symcreat.pas @@ -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. + diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 26db84be4d..dc63098191 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -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 diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 175e811e8d..59cea985b6 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -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;