--- Recording mergeinfo for merge of r39673 into '.':

U   .
--- Merging r39693 into '.':
A    tests/tbs/tb0650.pp
U    compiler/symtable.pas
--- Recording mergeinfo for merge of r39693 into '.':
 U   .
--- Merging r39700 into '.':
U    compiler/msg/errore.msg
--- Recording mergeinfo for merge of r39700 into '.':
 G   .
--- Merging r39701 into '.':
U    compiler/msgtxt.inc
U    compiler/msgidx.inc
--- Recording mergeinfo for merge of r39701 into '.':
 G   .
--- Merging r39702 into '.':
U    compiler/pdecsub.pas
A    tests/test/tgeneric105.pp
--- Recording mergeinfo for merge of r39702 into '.':
 G   .
--- Merging r39703 into '.':
A    tests/test/tgenfunc18.pp
A    tests/test/tgenfunc17.pp
G    compiler/pdecsub.pas
--- Recording mergeinfo for merge of r39703 into '.':
 G   .
--- Merging r39715 into '.':
U    packages/rtl-extra/src/inc/objects.pp
A    tests/webtbs/tw34239.pp
--- Recording mergeinfo for merge of r39715 into '.':
 G   .
--- Merging r39727 into '.':
G    packages/rtl-extra/src/inc/objects.pp
--- Recording mergeinfo for merge of r39727 into '.':
 G   .

# revisions: 39673,39693,39700,39701,39702,39703,39715,39727

git-svn-id: branches/fixes_3_2@39834 -

.gitattributes

@@ -11596,6 +11596,7 @@ tests/tbs/tb0646a.pp svneol=native#text/pascal
 tests/tbs/tb0646b.pp svneol=native#text/pascal
 tests/tbs/tb0648.pp svneol=native#text/pascal
 tests/tbs/tb0649.pp -text svneol=native#text/pascal
+tests/tbs/tb0650.pp svneol=native#text/pascal
 tests/tbs/tb205.pp svneol=native#text/plain
 tests/tbs/tb610.pp svneol=native#text/pascal
 tests/tbs/tb613.pp svneol=native#text/plain
@@ -13075,6 +13076,7 @@ tests/test/tgeneric101.pp svneol=native#text/pascal
 tests/test/tgeneric102.pp svneol=native#text/pascal
 tests/test/tgeneric103.pp 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/tgeneric12.pp svneol=native#text/plain
 tests/test/tgeneric13.pp svneol=native#text/plain
@@ -13180,6 +13182,8 @@ tests/test/tgenfunc13.pp svneol=native#text/pascal
 tests/test/tgenfunc14.pp svneol=native#text/pascal
 tests/test/tgenfunc15.pp svneol=native#text/pascal
 tests/test/tgenfunc16.pp svneol=native#text/pascal
+tests/test/tgenfunc17.pp svneol=native#text/pascal
+tests/test/tgenfunc18.pp svneol=native#text/pascal
 tests/test/tgenfunc2.pp svneol=native#text/pascal
 tests/test/tgenfunc3.pp svneol=native#text/pascal
 tests/test/tgenfunc4.pp svneol=native#text/pascal
@@ -16243,6 +16247,7 @@ tests/webtbs/tw3411.pp svneol=native#text/plain
 tests/webtbs/tw34124.pp svneol=native#text/pascal
 tests/webtbs/tw3418.pp svneol=native#text/plain
 tests/webtbs/tw3423.pp svneol=native#text/plain
+tests/webtbs/tw34239.pp svneol=native#text/pascal
 tests/webtbs/tw3429.pp svneol=native#text/plain
 tests/webtbs/tw3433.pp svneol=native#text/plain
 tests/webtbs/tw3435.pp svneol=native#text/plain

compiler/msg/errore.msg

@@ -2028,7 +2028,7 @@ type_w_empty_constant_range_set=04125_W_The first value of a set constructur ran
 #
 # Symtable
 #
-# 05095 is the last used one
+# 05097 is the last used one
 #
 % \section{Symbol handling}
 % This section lists all the messages that concern the handling of symbols.
@@ -2337,6 +2337,13 @@ sym_w_duplicate_id=05095_W_Duplicate identifier "$1"
 % same scope as the current identifier. This is a warning instead of an error,
 % because while this hides the identifier from the category, there are often
 % many unused categories in scope.
+sym_e_generic_type_param_mismatch=05096_E_Generic type parameter "$1" does not match with the one in the declaration
+% The specified generic type parameter for the generic class, record or routine does
+% not match with the one declared in the declaration of the generic class, record
+% or routine.
+sym_e_generic_type_param_decl=05097_E_Generic type parameter declared as "$1"
+% Shows what the generic type parameter was originally declared as if a mismatch
+% is found between a declaration and the definition.
 % \end{description}
 #
 # Codegenerator

compiler/msgidx.inc

@@ -657,6 +657,8 @@ const
   sym_w_managed_function_result_uninitialized=05093;
   sym_h_managed_function_result_uninitialized=05094;
   sym_w_duplicate_id=05095;
+  sym_e_generic_type_param_mismatch=05096;
+  sym_e_generic_type_param_decl=05097;
   cg_e_parasize_too_big=06009;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
@@ -1103,9 +1105,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 82410;
+  MsgTxtSize = 82541;
 
   MsgIdxMax : array[1..20] of longint=(
-    28,106,349,126,96,59,142,34,221,67,
+    28,106,349,126,98,59,142,34,221,67,
     62,20,30,1,1,1,1,1,1,1
   );

compiler/pdecsub.pas

@@ -856,6 +856,34 @@ implementation
               sp:='';
           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
         sp:='';
         orgsp:='';
@@ -952,6 +980,17 @@ implementation
                    srsym:=search_object_name(sp,true);
                  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 }
                  procstartfilepos:=current_tokenpos;
                  consume_proc_name;
@@ -3501,6 +3540,29 @@ const
     function proc_add_definition(var currpd:tprocdef):boolean;
 
 
+      function check_generic_parameters(fwpd,currpd:tprocdef):boolean;
+        var
+          i : longint;
+          fwtype,
+          currtype : ttypesym;
+        begin
+          result:=true;
+          if fwpd.genericparas.count<>currpd.genericparas.count then
+            internalerror(2018090101);
+          for i:=0 to fwpd.genericparas.count-1 do
+            begin
+              fwtype:=ttypesym(fwpd.genericparas[i]);
+              currtype:=ttypesym(currpd.genericparas[i]);
+              if fwtype.name<>currtype.name then
+                begin
+                  messagepos1(currtype.fileinfo,sym_e_generic_type_param_mismatch,currtype.realname);
+                  messagepos1(fwtype.fileinfo,sym_e_generic_type_param_decl,fwtype.realname);
+                  result:=false;
+                end;
+            end;
+        end;
+
+
       function equal_generic_procdefs(fwpd,currpd:tprocdef):boolean;
         var
           i : longint;
@@ -3805,6 +3867,13 @@ const
                         inc(fwidx);
                       until false;
                     end;
+                   { check that the type parameter names for generic methods match;
+                     we check this here and not in equal_generic_procdefs as the defs
+                     might still be different due to their parameters, so we'd generate
+                     errors without any need }
+                   if currpd.is_generic and fwpd.is_generic then
+                     { an error here is recoverable, so we simply continue }
+                     check_generic_parameters(fwpd,currpd);
                    { Everything is checked, now we can update the forward declaration
                      with the new data from the implementation }
                    fwpd.forwarddef:=currpd.forwarddef;

compiler/symtable.pas

@@ -1199,9 +1199,10 @@ implementation
         i : longint;
 {$endif codegen_workaround}
       begin
+        if refcount>1 then
+          exit;
 {$ifdef llvm}
-        if refcount=1 then
-          fllvmst.free;
+        fllvmst.free;
 {$endif llvm}
         for mop:=low(tmanagementoperator) to high(tmanagementoperator) do
           begin
@@ -2751,6 +2752,8 @@ implementation
 
     destructor twithsymtable.destroy;
       begin
+        if refcount>1 then
+          exit;
         withrefnode.free;
         { Disable SymList because we don't Own it }
         SymList:=nil;

packages/rtl-extra/src/inc/objects.pp

@@ -1013,8 +1013,8 @@ TYPE
    PVMT=^VMT;
    PPVMT=^PVMT;
    VMT=RECORD
-     Size,NegSize:Longint;
-     ParentLink:PVMT;
+     Size,NegSize:SizeInt;
+     ParentLink:PPVMT;
    END;
 VAR SP:PPVMT; Q:PVMT;
 BEGIN
@@ -1026,7 +1026,10 @@ BEGIN
        Is_Object:=True;
        Break;
      End;
-     Q:=Q^.Parentlink;
+     IF Q^.Parentlink<>Nil THEN
+       Q:=Q^.Parentlink^
+     ELSE
+       Q:=Nil;
    End;
 END;
 

tests/tbs/tb0650.pp

@@ -0,0 +1,21 @@
+unit tb0650;
+
+{$mode objfpc}{$H+}
+
+interface
+
+type
+  TTest = record
+    SomeField: String;
+  end;
+
+  TTestType = type TTest;
+
+  TTestClass = class
+    fField: TTestType;
+  end;
+
+implementation
+
+end.
+

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

tests/test/tgenfunc17.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ the type parameters of the implementation need to match those in the interface }
+unit tgenfunc17;
+
+{$mode objfpc}{$H+}
+
+interface
+
+generic procedure Test<T>;
+
+implementation
+
+generic procedure Test<S>;
+begin
+
+end;
+
+end.
+

tests/test/tgenfunc18.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ the type parameters of the implementation need to match those of the forward declaration }
+unit tgenfunc18;
+
+{$mode objfpc}{$H+}
+
+interface
+
+implementation
+
+generic procedure Test<T>; forward;
+
+generic procedure Test<S>;
+begin
+
+end;
+
+end.
+

tests/webtbs/tw34239.pp

@@ -0,0 +1,25 @@
+program tw34239;
+uses
+  objects;
+type
+  PTObj=^TObj;
+  TObj=object(TObject)
+  end;
+  TObj2=object(TObj)
+  end;
+  TSuperObj=object(TObj)
+  end;
+
+var
+  t2:TObj2;
+
+begin
+  t2.init;
+  if not t2.Is_Object(TypeOf(TObj)) then
+    Halt(1);
+  if t2.Is_Object(TypeOf(TSuperObj)) then
+    Halt(2);
+  //writeln(t2.Is_Object(TypeOf(TObj)));
+  //writeln(t2.Is_Object(TypeOf(TSuperObj)));
+  //readln;
+end.