Browse Source

* generate an error if the type parameters of the record, object or class do not match with its declaration
+ added test

git-svn-id: trunk@39702 -

svenbarth 7 years ago
parent
commit
50323043c1
3 changed files with 62 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 39 0
      compiler/pdecsub.pas
  3. 22 0
      tests/test/tgeneric105.pp

+ 1 - 0
.gitattributes

@@ -13076,6 +13076,7 @@ tests/test/tgeneric101.pp svneol=native#text/pascal
 tests/test/tgeneric102.pp svneol=native#text/pascal
 tests/test/tgeneric102.pp svneol=native#text/pascal
 tests/test/tgeneric103.pp svneol=native#text/pascal
 tests/test/tgeneric103.pp svneol=native#text/pascal
 tests/test/tgeneric104.pp -text svneol=native#text/pascal
 tests/test/tgeneric104.pp -text svneol=native#text/pascal
+tests/test/tgeneric105.pp svneol=native#text/pascal
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric11.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain

+ 39 - 0
compiler/pdecsub.pas

@@ -856,6 +856,34 @@ implementation
               sp:='';
               sp:='';
           end;
           end;
 
 
+        function check_generic_parameters(def:tstoreddef):boolean;
+          var
+            i : longint;
+            decltype,
+            impltype : ttypesym;
+            implname : tsymstr;
+          begin
+            result:=true;
+            if not assigned(def.genericparas) then
+              internalerror(2018090102);
+            if not assigned(genericparams) then
+              internalerror(2018090103);
+            if def.genericparas.count<>genericparams.count then
+              internalerror(2018090104);
+            for i:=0 to def.genericparas.count-1 do
+              begin
+                decltype:=ttypesym(def.genericparas[i]);
+                impltype:=ttypesym(genericparams[i]);
+                implname:=upper(genericparams.nameofindex(i));
+                if decltype.name<>implname then
+                  begin
+                    messagepos1(impltype.fileinfo,sym_e_generic_type_param_mismatch,impltype.realname);
+                    messagepos1(decltype.fileinfo,sym_e_generic_type_param_decl,decltype.realname);
+                    result:=false;
+                  end;
+              end;
+          end;
+
       begin
       begin
         sp:='';
         sp:='';
         orgsp:='';
         orgsp:='';
@@ -952,6 +980,17 @@ implementation
                    srsym:=search_object_name(sp,true);
                    srsym:=search_object_name(sp,true);
                  current_filepos:=oldfilepos;
                  current_filepos:=oldfilepos;
 
 
+                 { we need to check whether the names of the generic parameter
+                   types match with the one in the declaration of a class/record,
+                   but we need to do this before consume_proc_name frees the
+                   type parameters of the class part }
+                 if (srsym.typ=typesym) and
+                     (ttypesym(srsym).typedef.typ in [objectdef,recorddef]) and
+                     tstoreddef(ttypesym(srsym).typedef).is_generic and
+                     assigned(genericparams) then
+                   { this is recoverable, so no further action necessary }
+                   check_generic_parameters(tstoreddef(ttypesym(srsym).typedef));
+
                  { consume proc name }
                  { consume proc name }
                  procstartfilepos:=current_tokenpos;
                  procstartfilepos:=current_tokenpos;
                  consume_proc_name;
                  consume_proc_name;

+ 22 - 0
tests/test/tgeneric105.pp

@@ -0,0 +1,22 @@
+{ %FAIL }
+
+{ the type parameters of the implementation need to match those in the interface }
+unit tgeneric105;
+
+{$mode delphi}
+
+interface
+
+type
+  TTest<T> = class
+    procedure Test;
+  end;
+
+implementation
+
+procedure TTest<S>.Test;
+begin
+end;
+
+end.
+