From d2fabd2a22e132afa4f8b5300f0d5be368115014 Mon Sep 17 00:00:00 2001 From: svenbarth Date: Thu, 14 Jun 2012 07:07:28 +0000 Subject: [PATCH] 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" 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 - --- .gitattributes | 4 ++++ compiler/pdecobj.pas | 4 ++++ compiler/pgenutil.pas | 51 ++++++++++++++++++++++++++++++++++++++-- compiler/ppu.pas | 2 +- compiler/ptype.pas | 4 ++++ tests/test/tgeneric76.pp | 45 +++++++++++++++++++++++++++++++++++ tests/test/tgeneric77.pp | 48 +++++++++++++++++++++++++++++++++++++ tests/webtbs/tw21350a.pp | 45 +++++++++++++++++++++++++++++++++++ tests/webtbs/tw21350b.pp | 47 ++++++++++++++++++++++++++++++++++++ 9 files changed, 247 insertions(+), 3 deletions(-) create mode 100644 tests/test/tgeneric76.pp create mode 100644 tests/test/tgeneric77.pp create mode 100644 tests/webtbs/tw21350a.pp create mode 100644 tests/webtbs/tw21350b.pp diff --git a/.gitattributes b/.gitattributes index 2a76cc494b..a0e79d1571 100644 --- a/.gitattributes +++ b/.gitattributes @@ -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 diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 2b59d5aace..f284fda740 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -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 diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 02055054ea..c26c0b0ada 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -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; diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 7c21e52f44..f9ee577b07 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,7 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion = 150; + CurrentPPUVersion = 151; { buffer sizes } maxentrysize = 1024; diff --git a/compiler/ptype.pas b/compiler/ptype.pas index 29319b7d28..d25517b9f3 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -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; diff --git a/tests/test/tgeneric76.pp b/tests/test/tgeneric76.pp new file mode 100644 index 0000000000..4b2aa6ef6e --- /dev/null +++ b/tests/test/tgeneric76.pp @@ -0,0 +1,45 @@ +{$mode delphi} + +unit tgeneric76; + +interface + +type + + { TPointEx } + + TPointEx = 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 = TPointEx; + TPointF = TPointEx; + +implementation + +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. diff --git a/tests/test/tgeneric77.pp b/tests/test/tgeneric77.pp new file mode 100644 index 0000000000..060c802d37 --- /dev/null +++ b/tests/test/tgeneric77.pp @@ -0,0 +1,48 @@ +{$mode objfpc}{$h+} +{$modeswitch advancedrecords} + +unit tgeneric77; + +interface + +type + + { TPointEx } + + generic TPointEx = 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; + TPointF = specialize TPointEx; + +implementation + +{ TPoint } + +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. diff --git a/tests/webtbs/tw21350a.pp b/tests/webtbs/tw21350a.pp new file mode 100644 index 0000000000..a67d6b3997 --- /dev/null +++ b/tests/webtbs/tw21350a.pp @@ -0,0 +1,45 @@ +{$mode delphi} + +unit tw21350a; + +interface + +type + + { TPointEx } + + TPointEx = 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 = TPointEx; + TPointF = TPointEx; + +implementation + +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. diff --git a/tests/webtbs/tw21350b.pp b/tests/webtbs/tw21350b.pp new file mode 100644 index 0000000000..5aefe310db --- /dev/null +++ b/tests/webtbs/tw21350b.pp @@ -0,0 +1,47 @@ +{$mode objfpc}{$h+} + +unit tw21350b; + +interface + +type + + { TPointEx } + + generic TPointEx = 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; + TPointF = specialize TPointEx; + +implementation + +{ TPoint } + +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.