Browse Source

* fix for Mantis #36652: gracefully handle the error if one tries to implement a method of a type from another unit
+ added test

git-svn-id: trunk@44170 -

svenbarth 5 years ago
parent
commit
147559349b
6 changed files with 63 additions and 2 deletions
  1. 2 0
      .gitattributes
  2. 4 1
      compiler/msg/errore.msg
  3. 8 0
      compiler/pparautl.pas
  4. 8 1
      compiler/psub.pas
  5. 22 0
      tests/webtbf/tw36652.pp
  6. 19 0
      tests/webtbf/uw36652.pp

+ 2 - 0
.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

+ 4 - 1
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}
 %

+ 8 - 0
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

+ 8 - 1
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));

+ 22 - 0
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.

+ 19 - 0
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.