* when creating a unique type alias for an object, class or interface,

    create a child object/class/interface instead of a copy of the original.
    This fixes override/inheritance checks, and is also Delphi-compatible

git-svn-id: trunk@37927 -

.gitattributes

@@ -15736,6 +15736,7 @@ tests/webtbs/tw2926.pp svneol=native#text/plain
 tests/webtbs/tw2927.pp svneol=native#text/plain
 tests/webtbs/tw29321.pp svneol=native#text/pascal
 tests/webtbs/tw29353.pp -text svneol=native#text/plain
+tests/webtbs/tw29367.pp svneol=native#text/plain
 tests/webtbs/tw29372.pp svneol=native#text/pascal
 tests/webtbs/tw2942a.pp svneol=native#text/plain
 tests/webtbs/tw2942b.pp svneol=native#text/plain

compiler/pdecl.pas

@@ -687,44 +687,42 @@ implementation
                          is_java_class_or_interface(hdef) then
                         Message(parser_e_unique_unsupported);
 
-                      hdef:=tstoreddef(hdef).getcopy;
-
-                      { check if it is an ansistirng(codepage) declaration }
-                      if is_ansistring(hdef) and try_to_consume(_LKLAMMER) then
+                      if is_object(hdef) or
+                         is_class_or_interface_or_dispinterface(hdef) then
                         begin
-                          p:=comp_expr([ef_accept_equal]);
-                          consume(_RKLAMMER);
-                          if not is_constintnode(p) then
-                            begin
-                              Message(parser_e_illegal_expression);
-                              { error recovery }
-                            end
-                          else
+                          { just create a child class type; this is
+                            Delphi-compatible }
+                          hdef:=cobjectdef.create(tobjectdef(hdef).objecttype,genorgtypename,tobjectdef(hdef),true);
+                        end
+                      else
+                        begin
+                          hdef:=tstoreddef(hdef).getcopy;
+                          { check if it is an ansistirng(codepage) declaration }
+                          if is_ansistring(hdef) and try_to_consume(_LKLAMMER) then
                             begin
-                              if (tordconstnode(p).value<0) or (tordconstnode(p).value>65535) then
+                              p:=comp_expr([ef_accept_equal]);
+                              consume(_RKLAMMER);
+                              if not is_constintnode(p) then
                                 begin
-                                  Message(parser_e_invalid_codepage);
-                                  tordconstnode(p).value:=0;
+                                  Message(parser_e_illegal_expression);
+                                  { error recovery }
+                                end
+                              else
+                                begin
+                                  if (tordconstnode(p).value<0) or (tordconstnode(p).value>65535) then
+                                    begin
+                                      Message(parser_e_invalid_codepage);
+                                      tordconstnode(p).value:=0;
+                                    end;
+                                  tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
                                 end;
-                              tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
+                              p.free;
                             end;
-                          p.free;
+                          if (hdef.typ in [pointerdef,classrefdef]) and
+                             (tabstractpointerdef(hdef).pointeddef.typ=forwarddef) then
+                            current_module.checkforwarddefs.add(hdef);
                         end;
-
-                      { fix name, it is used e.g. for tables }
-                      if is_class_or_interface_or_dispinterface(hdef) then
-                        with tobjectdef(hdef) do
-                          begin
-                            stringdispose(objname);
-                            stringdispose(objrealname);
-                            objrealname:=stringdup(genorgtypename);
-                            objname:=stringdup(upper(genorgtypename));
-                          end;
-
                       include(hdef.defoptions,df_unique);
-                      if (hdef.typ in [pointerdef,classrefdef]) and
-                         (tabstractpointerdef(hdef).pointeddef.typ=forwarddef) then
-                        current_module.checkforwarddefs.add(hdef);
                     end;
                   if not assigned(hdef.typesym) then
                     begin

tests/webtbs/tw29367.pp

@@ -0,0 +1,30 @@
+program Project1;
+{$Mode objfpc}
+
+type
+  TFoo = class
+    constructor create; virtual;
+  end;
+
+  TBar = type TFoo;
+
+  TBaz = class(TBar)
+    constructor create; override;
+  end;
+
+constructor TFoo.create;
+begin end;
+
+constructor TBaz.create;
+begin end;
+
+begin
+  if not tbar.inheritsfrom(tfoo) then
+    halt(1);
+  if not tbaz.inheritsfrom(tbar) then
+    halt(2);
+  if tbar.classname<>'TBar' then
+    halt(3);
+  if tfoo.classname<>'TFoo' then
+    halt(4);
+end.