diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index dd1dfc2f3e..4bfc414fd0 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -1134,7 +1134,11 @@ implementation { Build VMT indexes, skip for type renaming and forward classes } if not istyperenaming and not(oo_is_forward in tobjectdef(hdef).objectoptions) then - build_vmt(tobjectdef(hdef)); + if not (oo_inherits_not_specialized in tobjectdef(hdef).objectoptions) then + build_vmt(tobjectdef(hdef)) + else + { update the procdevs to add hidden self param } + insert_struct_hidden_paras(tobjectdef(hdef)); { In case of an objcclass, verify that all methods have a message name set. We only check this now, because message names can be set diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 5f9a984ebe..a7f08b8b7a 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -2058,8 +2058,11 @@ uses if oo_is_forward in tobjectdef(result).objectoptions then add_forward_generic_def(result,context) + else if not (oo_inherits_not_specialized in tobjectdef(result).objectoptions) then + build_vmt(tobjectdef(result)) else - build_vmt(tobjectdef(result)); + { update the procdevs to add hidden self param } + insert_struct_hidden_paras(tobjectdef(result)); end; { handle params, calling convention, etc } procvardef: diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 5d97a13f3f..25b2e9f356 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -48,7 +48,7 @@ const CurrentPPUVersion = 208; { for any other changes to the ppu format, increase this version number (it's a cardinal) } - CurrentPPULongVersion = 26; + CurrentPPULongVersion = 27; { unit flags } uf_big_endian = $000004; diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 461a7e25f8..f256d89a06 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -585,7 +585,8 @@ type oo_has_new_destructor,{ the object/class declares a destructor (apart from potentially inherting one from the parent) } oo_is_funcref, { interface has a single Invoke method that can be directly called } oo_is_invokable, { interface that is invokable like a function } - oo_is_capturer { the class is the capturer for anonymous functions (or converted proc(var)s) } + oo_is_capturer, { the class is the capturer for anonymous functions (or converted proc(var)s) } + oo_inherits_not_specialized { the class inherits from a not yet specialized type } ); tobjectoptions=set of tobjectoption; @@ -895,7 +896,7 @@ const {$ifndef jvm} inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected, oo_has_strictprotected,oo_has_strictprivate,oo_has_constructor,oo_has_destructor, - oo_can_have_published]; + oo_can_have_published,oo_inherits_not_specialized]; {$else not jvm} { constructors are not inherited in Java } inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected, diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 2353e8ff30..3d85c79d48 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -8327,6 +8327,9 @@ implementation exit; { inherit options and status } objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions); + { check if parent is a generic parameter } + if sp_generic_para in c.typesym.symoptions then + objectoptions:=objectoptions+[oo_inherits_not_specialized]; { initially has the same number of abstract methods as the parent } abstractcnt:=c.abstractcnt; { add the data of the anchestor class/object } diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index cefc213eba..1adc81fd94 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -3302,7 +3302,8 @@ const (mask:oo_has_new_destructor; str:'HasNewDestructor'), (mask:oo_is_funcref; str:'IsFuncRef'), (mask:oo_is_invokable; str:'IsInvokable'), - (mask:oo_is_capturer; str:'IsCapturer') + (mask:oo_is_capturer; str:'IsCapturer'), + (mask:oo_inherits_not_specialized; str:'InheritedNotSpecialized') ); var i : longint; diff --git a/tests/test/tgeneric112.pp b/tests/test/tgeneric112.pp new file mode 100644 index 0000000000..d127c7da73 --- /dev/null +++ b/tests/test/tgeneric112.pp @@ -0,0 +1,15 @@ +{$Mode ObjFPC}{$H+} + +type + generic TTest = class(T) + public + function Foo:Integer;override; + end; + +function TTest.Foo:Integer; +begin + Result:=42; +end; + +begin +end. diff --git a/tests/test/tgeneric113.pp b/tests/test/tgeneric113.pp new file mode 100644 index 0000000000..3520a4bda2 --- /dev/null +++ b/tests/test/tgeneric113.pp @@ -0,0 +1,26 @@ +{$Mode ObjFPC}{$H+} + +type + TBase = class + public + function Foo:Integer;virtual;abstract; + end; + + generic TTest = class(T) + public + function Foo:Integer;override; + end; + +function TTest.Foo:Integer; +begin + Result:=42; +end; + +var + b: TBase; +begin + b:=specialize TTest.Create; + if b.Foo<>42 then + Halt(1); + WriteLn('Ok'); +end. diff --git a/tests/test/tgeneric114.pp b/tests/test/tgeneric114.pp new file mode 100644 index 0000000000..f962eb6338 --- /dev/null +++ b/tests/test/tgeneric114.pp @@ -0,0 +1,26 @@ +{ %FAIL } +{$Mode ObjFPC}{$H+} + +type + TBase = class + public + end; + + generic TTest = class(T) + public + function Foo:Integer;override; + end; + +function TTest.Foo:Integer; +begin + Result:=42; +end; + +var + b: TBase; +begin + b:=specialize TTest.Create; + if b.Foo<>42 then + Halt(1); + WriteLn('Ok'); +end. diff --git a/tests/test/tgeneric115.pp b/tests/test/tgeneric115.pp new file mode 100644 index 0000000000..508288127b --- /dev/null +++ b/tests/test/tgeneric115.pp @@ -0,0 +1,30 @@ +{$Mode ObjFPC}{$H+} + +type + TBase = class + public + function Foo:Integer;virtual;abstract; + end; + + generic TTest = class(T) + public + function Foo:Integer;override; + end; + + generic TTest2 = class(specialize TTest) + public + end; + +function TTest.Foo:Integer; +begin + Result:=42; +end; + +var + b: TBase; +begin + b:=specialize TTest2.Create; + if b.Foo<>42 then + Halt(1); + WriteLn('Ok'); +end. diff --git a/tests/test/tgeneric116.pp b/tests/test/tgeneric116.pp new file mode 100644 index 0000000000..b6b6700f04 --- /dev/null +++ b/tests/test/tgeneric116.pp @@ -0,0 +1,30 @@ +{$Mode ObjFPC}{$H+} + +type + TBase = class + public + function Foo:Integer;virtual;abstract; + end; + + generic TTest = class(T) + public + end; + + generic TTest2 = class(specialize TTest) + public + function Foo:Integer;override; + end; + +function TTest2.Foo:Integer; +begin + Result:=42; +end; + +var + b: TBase; +begin + b:=specialize TTest2.Create; + if b.Foo<>42 then + Halt(1); + WriteLn('Ok'); +end.