mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 17:10:28 +02:00
Fix for Mantis #21350
+ pgenutil.pas: add a procedure which adds a type symbol to a non-Delphi-mode generic class or record which has the same name as the unit global dummy symbol for that generic. I don't know why I had that idea earlier as this will simplify some of the conditions in the parser again (I haven't changed these yet, but I hope to do that at least when I start working on generic functions). * pgenutil.pas, generate_specialization: correctly handle "specialize TSomeGeneric<T>" as method parameter in a generic with the newly added rename symbol * pdecobj.pas, object_dec & ptype.pas, record_dec: call the procedure to add the rename symbol (the procedure checks whether the mode is correct) * ppu.pas: increase PPU version so that we don't use non-Delphi mode units with generics, but without the rename symbol + added tests: the one in webtbs are for classes/objects and those in test are for records git-svn-id: trunk@21603 -
This commit is contained in:
parent
e8c7635d49
commit
d2fabd2a22
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -10712,6 +10712,8 @@ tests/test/tgeneric72.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric73.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric74.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric75.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric76.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric77.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric8.pp svneol=native#text/plain
|
||||
tests/test/tgeneric9.pp svneol=native#text/plain
|
||||
tests/test/tgoto.pp svneol=native#text/plain
|
||||
@ -12599,6 +12601,8 @@ tests/webtbs/tw2128.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2129.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2129b.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2131.pp svneol=native#text/plain
|
||||
tests/webtbs/tw21350a.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21350b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21443.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2145.pp svneol=native#text/plain
|
||||
tests/webtbs/tw21457.pp svneol=native#text/pascal
|
||||
|
@ -1409,6 +1409,10 @@ implementation
|
||||
include(current_structdef.defoptions, df_generic);
|
||||
parse_generic:=(df_generic in current_structdef.defoptions);
|
||||
|
||||
{ in non-Delphi modes we need a strict private symbol without type
|
||||
count and type parameters in the name to simply resolving }
|
||||
maybe_insert_generic_rename_symbol(n,genericlist);
|
||||
|
||||
{ parse list of parent classes }
|
||||
{ for record helpers in mode Delphi this is not allowed }
|
||||
if not (is_objectpascal_helper(current_objectdef) and
|
||||
|
@ -29,12 +29,15 @@ interface
|
||||
uses
|
||||
{ common }
|
||||
cclasses,
|
||||
{ global }
|
||||
globtype,
|
||||
{ symtable }
|
||||
symtype,symdef,symbase;
|
||||
|
||||
procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string);
|
||||
function parse_generic_parameters:TFPObjectList;
|
||||
procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
|
||||
procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
|
||||
|
||||
type
|
||||
tspecializationstate = record
|
||||
@ -51,7 +54,7 @@ uses
|
||||
{ common }
|
||||
cutils,fpccrc,
|
||||
{ global }
|
||||
globals,globtype,tokens,verbose,
|
||||
globals,tokens,verbose,
|
||||
{ symtable }
|
||||
symconst,symsym,symtable,
|
||||
{ modules }
|
||||
@ -257,7 +260,8 @@ uses
|
||||
genname:=symname;
|
||||
{ in case of non-Delphi mode the type name could already be a generic
|
||||
def (but maybe the wrong one) }
|
||||
if assigned(genericdef) and (df_generic in genericdef.defoptions) then
|
||||
if assigned(genericdef) and
|
||||
([df_generic,df_specialization]*genericdef.defoptions<>[]) then
|
||||
begin
|
||||
{ remove the type count suffix from the generic's name }
|
||||
for i:=Length(genname) downto 1 do
|
||||
@ -266,6 +270,15 @@ uses
|
||||
genname:=copy(genname,1,i-1);
|
||||
break;
|
||||
end;
|
||||
{ in case of a specialization we've only reached the specialization
|
||||
checksum yet }
|
||||
if df_specialization in genericdef.defoptions then
|
||||
for i:=length(genname) downto 1 do
|
||||
if genname[i]='$' then
|
||||
begin
|
||||
genname:=copy(genname,1,i-1);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
genname:=genname+'$'+countstr;
|
||||
ugenname:=upper(genname);
|
||||
@ -587,6 +600,40 @@ uses
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
|
||||
var
|
||||
gensym : ttypesym;
|
||||
begin
|
||||
{ for generics in non-Delphi modes we insert a private type symbol
|
||||
that has the same base name as the currently parsed generic and
|
||||
that references this defs }
|
||||
if not (m_delphi in current_settings.modeswitches) and
|
||||
(
|
||||
(
|
||||
parse_generic and
|
||||
assigned(genericlist) and
|
||||
(genericlist.count>0)
|
||||
) or
|
||||
(
|
||||
assigned(current_specializedef) and
|
||||
assigned(current_structdef.genericdef) and
|
||||
(current_structdef.genericdef.typ in [objectdef,recorddef]) and
|
||||
(pos('$',name)>0)
|
||||
)
|
||||
) then
|
||||
begin
|
||||
{ we need to pass nil as def here, because the constructor wants
|
||||
to set the typesym of the def which is not what we want }
|
||||
gensym:=ttypesym.create(copy(name,1,pos('$',name)-1),nil);
|
||||
gensym.typedef:=current_structdef;
|
||||
include(gensym.symoptions,sp_internal);
|
||||
{ the symbol should be only visible to the generic class
|
||||
itself }
|
||||
gensym.visibility:=vis_strictprivate;
|
||||
symtablestack.top.insert(gensym);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure specialization_init(genericdef:tdef;var state: tspecializationstate);
|
||||
var
|
||||
pu : tused_unit;
|
||||
|
@ -43,7 +43,7 @@ type
|
||||
{$endif Test_Double_checksum}
|
||||
|
||||
const
|
||||
CurrentPPUVersion = 150;
|
||||
CurrentPPUVersion = 151;
|
||||
|
||||
{ buffer sizes }
|
||||
maxentrysize = 1024;
|
||||
|
@ -775,6 +775,10 @@ implementation
|
||||
if old_parse_generic then
|
||||
include(current_structdef.defoptions, df_generic);
|
||||
parse_generic:=(df_generic in current_structdef.defoptions);
|
||||
{ in non-Delphi modes we need a strict private symbol without type
|
||||
count and type parameters in the name to simply resolving }
|
||||
maybe_insert_generic_rename_symbol(n,genericlist);
|
||||
|
||||
if m_advanced_records in current_settings.modeswitches then
|
||||
begin
|
||||
parse_record_members;
|
||||
|
45
tests/test/tgeneric76.pp
Normal file
45
tests/test/tgeneric76.pp
Normal file
@ -0,0 +1,45 @@
|
||||
{$mode delphi}
|
||||
|
||||
unit tgeneric76;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
|
||||
{ TPointEx }
|
||||
|
||||
TPointEx<T> = record
|
||||
X, Y: T;
|
||||
function Create(const AX, AY: T): TPointEx<T>;
|
||||
class procedure Swap(var A, B: TPointEx<T>); static;
|
||||
class procedure OrderByY(var A, B: TPointEx<T>); static;
|
||||
end;
|
||||
|
||||
TPoint = TPointEx<integer>;
|
||||
TPointF = TPointEx<single>;
|
||||
|
||||
implementation
|
||||
|
||||
function TPointEx<T>.Create(const AX, AY: T): TPointEx<T>;
|
||||
begin
|
||||
result.X:=AX;
|
||||
result.Y:=AY;
|
||||
end;
|
||||
|
||||
class procedure TPointEx<T>.Swap(var A, B: TPointEx<T>);
|
||||
var
|
||||
tmp: TPointEx<T>;
|
||||
begin
|
||||
tmp:=A;
|
||||
A:=B;
|
||||
B:=tmp;
|
||||
end;
|
||||
|
||||
class procedure TPointEx<T>.OrderByY(var A, B: TPointEx<T>);
|
||||
begin
|
||||
if A.Y > B.Y then
|
||||
TPointEx<T>.Swap(A,B);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
48
tests/test/tgeneric77.pp
Normal file
48
tests/test/tgeneric77.pp
Normal file
@ -0,0 +1,48 @@
|
||||
{$mode objfpc}{$h+}
|
||||
{$modeswitch advancedrecords}
|
||||
|
||||
unit tgeneric77;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
|
||||
{ TPointEx }
|
||||
|
||||
generic TPointEx<T> = record
|
||||
X, Y: T;
|
||||
function Create(const AX, AY: T): TPointEx;
|
||||
class procedure Swap(var A, B: TPointEx); static;
|
||||
class procedure OrderByY(var A, B: TPointEx); static;
|
||||
end;
|
||||
|
||||
//TPoint = specialize TPointEx<integer>;
|
||||
TPointF = specialize TPointEx<single>;
|
||||
|
||||
implementation
|
||||
|
||||
{ TPoint<T> }
|
||||
|
||||
function TPointEx.Create(const AX, AY: T): TPointEx;
|
||||
begin
|
||||
result.X:=AX;
|
||||
result.Y:=AY;
|
||||
end;
|
||||
|
||||
class procedure TPointEx.Swap(var A, B: TPointEx);
|
||||
var
|
||||
tmp: TPointEx;
|
||||
begin
|
||||
tmp:=A;
|
||||
A:=B;
|
||||
B:=tmp;
|
||||
end;
|
||||
|
||||
class procedure TPointEx.OrderByY(var A, B: TPointEx);
|
||||
begin
|
||||
if A.Y > B.Y then
|
||||
TPointEx.Swap(A,B);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
45
tests/webtbs/tw21350a.pp
Normal file
45
tests/webtbs/tw21350a.pp
Normal file
@ -0,0 +1,45 @@
|
||||
{$mode delphi}
|
||||
|
||||
unit tw21350a;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
|
||||
{ TPointEx }
|
||||
|
||||
TPointEx<T> = object
|
||||
X, Y: T;
|
||||
function Create(const AX, AY: T): TPointEx<T>;
|
||||
class procedure Swap(var A, B: TPointEx<T>); static;
|
||||
class procedure OrderByY(var A, B: TPointEx<T>); static;
|
||||
end;
|
||||
|
||||
TPoint = TPointEx<integer>;
|
||||
TPointF = TPointEx<single>;
|
||||
|
||||
implementation
|
||||
|
||||
function TPointEx<T>.Create(const AX, AY: T): TPointEx<T>;
|
||||
begin
|
||||
result.X:=AX;
|
||||
result.Y:=AY;
|
||||
end;
|
||||
|
||||
class procedure TPointEx<T>.Swap(var A, B: TPointEx<T>);
|
||||
var
|
||||
tmp: TPointEx<T>;
|
||||
begin
|
||||
tmp:=A;
|
||||
A:=B;
|
||||
B:=tmp;
|
||||
end;
|
||||
|
||||
class procedure TPointEx<T>.OrderByY(var A, B: TPointEx<T>);
|
||||
begin
|
||||
if A.Y > B.Y then
|
||||
TPointEx<T>.Swap(A,B);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
47
tests/webtbs/tw21350b.pp
Normal file
47
tests/webtbs/tw21350b.pp
Normal file
@ -0,0 +1,47 @@
|
||||
{$mode objfpc}{$h+}
|
||||
|
||||
unit tw21350b;
|
||||
|
||||
interface
|
||||
|
||||
type
|
||||
|
||||
{ TPointEx }
|
||||
|
||||
generic TPointEx<T> = object
|
||||
X, Y: T;
|
||||
function Create(const AX, AY: T): TPointEx;
|
||||
class procedure Swap(var A, B: TPointEx); static;
|
||||
class procedure OrderByY(var A, B: TPointEx); static;
|
||||
end;
|
||||
|
||||
//TPoint = specialize TPointEx<integer>;
|
||||
TPointF = specialize TPointEx<single>;
|
||||
|
||||
implementation
|
||||
|
||||
{ TPoint<T> }
|
||||
|
||||
function TPointEx.Create(const AX, AY: T): TPointEx;
|
||||
begin
|
||||
result.X:=AX;
|
||||
result.Y:=AY;
|
||||
end;
|
||||
|
||||
class procedure TPointEx.Swap(var A, B: TPointEx);
|
||||
var
|
||||
tmp: TPointEx;
|
||||
begin
|
||||
tmp:=A;
|
||||
A:=B;
|
||||
B:=tmp;
|
||||
end;
|
||||
|
||||
class procedure TPointEx.OrderByY(var A, B: TPointEx);
|
||||
begin
|
||||
if A.Y > B.Y then
|
||||
TPointEx.Swap(A,B);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
Loading…
Reference in New Issue
Block a user