Ver código fonte

* fix #40764: declare procsyms of a class/object also as sp_generic_dummysym if a symbol in a parent class has it set so that the parser will treat it as a potential generic
+ added test

Sven/Sarah Barth 1 ano atrás
pai
commit
485b31de21
4 arquivos alterados com 142 adições e 0 exclusões
  1. 22 0
      compiler/pdecsub.pas
  2. 43 0
      tests/webtbs/tw40764.pp
  3. 41 0
      tests/webtbs/uw40764a.pp
  4. 36 0
      tests/webtbs/uw40764b.pp

+ 22 - 0
compiler/pdecsub.pas

@@ -555,6 +555,7 @@ implementation
         genericst: TSymtable;
         aprocsym : tprocsym;
         popclass : integer;
+        parentdef : tobjectdef;
         ImplIntf : TImplementedInterface;
         old_parse_generic : boolean;
         old_current_structdef: tabstractrecorddef;
@@ -1053,6 +1054,27 @@ implementation
                     assigned(current_module.globalsymtable) then
                    srsym:=tsym(current_module.globalsymtable.Find(sp));
 
+                 { if the symbol isn't assigned, but we're parsing a class or
+                   object then check in the parent types for symbols of the same
+                   name that are generics and declare the new symbol as a generic
+                   dummy symbol }
+
+                 if not assigned(srsym) and is_class_or_object(astruct) then
+                   begin
+                     parentdef:=tobjectdef(astruct).childof;
+                     while assigned(parentdef) do
+                       begin
+                         srsym:=tsym(parentdef.symtable.Find(sp));
+                         if assigned(srsym) and (sp_generic_dummy in srsym.symoptions) then
+                           begin
+                             addgendummy:=true;
+                             break;
+                           end;
+                         parentdef:=parentdef.childof;
+                       end;
+                     srsym:=nil;
+                   end;
+
                  { Check if overloaded is a procsym }
                  if assigned(srsym) then
                    begin

+ 43 - 0
tests/webtbs/tw40764.pp

@@ -0,0 +1,43 @@
+unit tw40764;
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+interface
+
+uses uw40764a,uw40764b;
+
+Type
+  
+  TBrushFMXStyle = class(TFMXObject)
+  end;
+  
+  TPresentedControl = class(TStyledControl)
+    function FindStyleResource(const AStyleLookup: string; const AClone: Boolean = False): TFmxObject; overload; override;  
+  end;
+
+  TMyControl = class(TPresentedControl)
+    Procedure DoTest;
+  end;
+  
+implementation
+
+  
+function TPresentedControl.FindStyleResource(const AStyleLookup: string; const AClone: Boolean = False): TFmxObject;
+
+begin
+end;
+
+
+procedure TMyControl.DoTest;
+
+var
+  B : Boolean;
+  BrushObject : TBrushObject;
+
+begin
+  B:=FindStyleResource<TBrushObject>( 'foreground' , BrushObject );
+end;
+
+end.

+ 41 - 0
tests/webtbs/uw40764a.pp

@@ -0,0 +1,41 @@
+unit uw40764a;
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+interface
+ 
+  
+Type
+  TFMXObject = class(TObject)
+    procedure something; virtual;
+    function FindStyleResource(const AStyleLookup: string; const AClone: Boolean = False): TFmxObject; overload; virtual;
+  end;
+  
+  TBrushObject = class(TFMXObject)
+    procedure something; override;
+  end;  
+  
+implementation
+
+function TFMXObject.FindStyleResource(const AStyleLookup: string; const AClone: Boolean = False): TFmxObject; 
+begin
+  Result:=Nil;
+end;
+
+procedure TFMXObject.something;
+
+begin
+  writeln('here')
+end;
+
+procedure TBrushObject.something;
+
+begin
+  inherited something;
+  Writeln('here too')
+end;
+
+end.  
+  

+ 36 - 0
tests/webtbs/uw40764b.pp

@@ -0,0 +1,36 @@
+unit uw40764b;
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+interface
+
+uses uw40764a;
+
+Type
+
+  TStyledControl = class (tfmxobject)
+    function FindStyleResource(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject; overload; override;
+    function FindStyleResource<T: TFmxObject>(const AStyleLookup: string; var AResource: T): Boolean; overload;
+  end;
+
+implementation
+
+function TStyledControl.FindStyleResource(const AStyleLookup: string; const Clone: Boolean = False): TFmxObject; 
+
+begin
+  Result:=Nil;
+end;
+
+function TStyledControl.FindStyleResource<T>(const AStyleLookup: string; var AResource: T): Boolean;
+
+begin
+  Result:= aStyleLookup<>'';
+  if Result then
+    aResource:=T(TObject.Create)
+  else
+    aResource:=Nil;
+end;
+
+end.