diff --git a/.gitattributes b/.gitattributes index 63f8060618..cd6bdf4b87 100644 --- a/.gitattributes +++ b/.gitattributes @@ -16227,6 +16227,7 @@ tests/webtbf/tw36554.pp svneol=native#text/pascal tests/webtbf/tw3662.pp svneol=native#text/plain tests/webtbf/tw36631a.pp svneol=native#text/pascal tests/webtbf/tw36631b.pp svneol=native#text/pascal +tests/webtbf/tw36652.pp svneol=native#text/pascal tests/webtbf/tw3680.pp svneol=native#text/plain tests/webtbf/tw3716.pp svneol=native#text/plain tests/webtbf/tw3738.pp svneol=native#text/plain @@ -16363,6 +16364,7 @@ tests/webtbf/uw25283.pp svneol=native#text/plain tests/webtbf/uw27378a.pp svneol=native#text/pascal tests/webtbf/uw27378b.pp svneol=native#text/pascal tests/webtbf/uw3450.pp svneol=native#text/plain +tests/webtbf/uw36652.pp svneol=native#text/pascal tests/webtbf/uw3969.pp svneol=native#text/plain tests/webtbf/uw4103.pp svneol=native#text/plain tests/webtbf/uw4541.pp svneol=native#text/pascal diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index df663919cd..975e6a42a3 100644 --- a/compiler/msg/errore.msg +++ b/compiler/msg/errore.msg @@ -436,7 +436,7 @@ scan_n_changecputype=02105_N_Changed CPU type to be consistent with specified co # # Parser # -# 03353 is the last used one +# 03354 is the last used one # % \section{Parser messages} % This section lists all parser messages. The parser takes care of the @@ -1606,6 +1606,9 @@ parser_e_enumeration_out_of_range=03352_E_Enumeration symbols can only have valu parser_w_enumeration_out_of_range=03353_W_Enumeration symbols can only have values in the range of -2^31 to 2^31-1 % The size of enumeration values is limited to 4 bytes. As the value can be signed, the range % of valid values is limited to a signed 32 Bit value (i.e. \var{longint}). +parser_e_method_for_type_in_other_unit=03354_E_Implementing a method for type "$1" declared in another unit +% This error occurs if one tries to define a method for a type that is originally declared +% in a different unit. % % \end{description} % diff --git a/compiler/pparautl.pas b/compiler/pparautl.pas index 1f1828a6fc..f18ca3a515 100644 --- a/compiler/pparautl.pas +++ b/compiler/pparautl.pas @@ -719,6 +719,14 @@ implementation begin forwardfound:=false; + if assigned(currpd.struct) and + (currpd.struct.symtable.moduleid<>current_module.moduleid) and + not currpd.is_specialization then + begin + result:=false; + exit; + end; + { check overloaded functions if the same function already exists } for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do begin diff --git a/compiler/psub.pas b/compiler/psub.pas index 27352fa491..2866430aa5 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -2491,8 +2491,15 @@ implementation { search for forward declarations } if not proc_add_definition(pd) then begin - { A method must be forward defined (in the object declaration) } + { One may not implement a method of a type declared in a different unit } if assigned(pd.struct) and + (pd.struct.symtable.moduleid<>current_module.moduleid) and + not pd.is_specialization then + begin + MessagePos1(pd.fileinfo,parser_e_method_for_type_in_other_unit,pd.struct.typesymbolprettyname); + end + { A method must be forward defined (in the object declaration) } + else if assigned(pd.struct) and (not assigned(old_current_structdef)) then begin MessagePos1(pd.fileinfo,parser_e_header_dont_match_any_member,pd.fullprocname(false)); diff --git a/tests/webtbf/tw36652.pp b/tests/webtbf/tw36652.pp new file mode 100644 index 0000000000..6157ddddae --- /dev/null +++ b/tests/webtbf/tw36652.pp @@ -0,0 +1,22 @@ +{ %FAIL } +{ %RECOMPILE } + +{$mode objfpc} +{$interfaces corba} + +program tw36652; +uses + uw36652; + +type + TClassB = class + procedure DoThis; + end; + +// 2014010312 +procedure TClassA.DoThis; +begin +end; + +begin +end. diff --git a/tests/webtbf/uw36652.pp b/tests/webtbf/uw36652.pp new file mode 100644 index 0000000000..0d048efde3 --- /dev/null +++ b/tests/webtbf/uw36652.pp @@ -0,0 +1,19 @@ +{$mode objfpc} +{$interfaces corba} + +unit uw36652; +interface + +type + TClassA = class + procedure DoThis; + end; + +implementation + +procedure TClassA.DoThis; +begin + +end; + +end.