Ver Fonte

Fix for Mantis #26288. Types declared inside a generic must have the df_generic flag set. Period.

ptype.pas, read_named_type:
  * array_dec & procvar_dec: set df_generic of the array/procvar if parse_generic was originally set

+ added test

git-svn-id: trunk@27874 -
svenbarth há 11 anos atrás
pai
commit
aca48a4cf2
3 ficheiros alterados com 61 adições e 2 exclusões
  1. 1 0
      .gitattributes
  2. 6 2
      compiler/ptype.pas
  3. 54 0
      tests/webtbs/tw26288.pp

+ 1 - 0
.gitattributes

@@ -13945,6 +13945,7 @@ tests/webtbs/tw26230.pp svneol=native#text/plain
 tests/webtbs/tw2626.pp svneol=native#text/plain
 tests/webtbs/tw2626.pp svneol=native#text/plain
 tests/webtbs/tw2627.pp svneol=native#text/plain
 tests/webtbs/tw2627.pp svneol=native#text/plain
 tests/webtbs/tw26271.pp svneol=native#text/pascal
 tests/webtbs/tw26271.pp svneol=native#text/pascal
+tests/webtbs/tw26288.pp svneol=native#text/pascal
 tests/webtbs/tw2631.pp svneol=native#text/plain
 tests/webtbs/tw2631.pp svneol=native#text/plain
 tests/webtbs/tw26408.pp svneol=native#text/pascal
 tests/webtbs/tw26408.pp svneol=native#text/pascal
 tests/webtbs/tw2643.pp svneol=native#text/plain
 tests/webtbs/tw2643.pp svneol=native#text/plain

+ 6 - 2
compiler/ptype.pas

@@ -1262,7 +1262,9 @@ implementation
              in both cases we need "parse_generic" and "current_genericdef"
              in both cases we need "parse_generic" and "current_genericdef"
              so that e.g. specializations of another generic inside the
              so that e.g. specializations of another generic inside the
              current generic can be used (either inline ones or "type" ones) }
              current generic can be used (either inline ones or "type" ones) }
-           parse_generic:=(df_generic in arrdef.defoptions) or old_parse_generic;
+           if old_parse_generic then
+             include(arrdef.defoptions,df_generic);
+           parse_generic:=(df_generic in arrdef.defoptions);
            if parse_generic and not assigned(current_genericdef) then
            if parse_generic and not assigned(current_genericdef) then
              current_genericdef:=old_current_genericdef;
              current_genericdef:=old_current_genericdef;
 
 
@@ -1426,7 +1428,9 @@ implementation
               in both cases we need "parse_generic" and "current_genericdef"
               in both cases we need "parse_generic" and "current_genericdef"
               so that e.g. specializations of another generic inside the
               so that e.g. specializations of another generic inside the
               current generic can be used (either inline ones or "type" ones) }
               current generic can be used (either inline ones or "type" ones) }
-            parse_generic:=(df_generic in pd.defoptions) or old_parse_generic;
+            if old_parse_generic then
+              include(pd.defoptions,df_generic);
+            parse_generic:=(df_generic in pd.defoptions);
             if parse_generic and not assigned(current_genericdef) then
             if parse_generic and not assigned(current_genericdef) then
               current_genericdef:=old_current_genericdef;
               current_genericdef:=old_current_genericdef;
             { don't allow to add defs to the symtable - use it for type param search only }
             { don't allow to add defs to the symtable - use it for type param search only }

+ 54 - 0
tests/webtbs/tw26288.pp

@@ -0,0 +1,54 @@
+unit tw26288;
+
+{$mode objfpc}{$h+}
+
+interface
+
+uses
+  Classes, SysUtils;
+  
+type  
+  { TGenVector }
+  generic TGenVector<_TItem_> = class
+  public type
+    TItemToString = function (const Item: _TItem_) : String of object;
+    
+  strict private 
+    fOnItemToString: TItemToString;
+    
+    procedure SetOnItemToString(AValue: TItemToString);
+    
+  public
+    constructor Create;
+    
+    function DefaultItemToString(const Item: _TItem_) : String; virtual;
+    
+    property OnItemToString : TItemToString read fOnItemToString 
+      write SetOnItemToString;
+  end;
+  
+implementation
+
+{--- TGenVector.Create ---}
+constructor TGenVector.Create;
+begin
+  SetOnItemToString(nil);
+end;
+
+{--- TGenVector.DefaultItemToString ---}
+function TGenVector.DefaultItemToString(const Item: _TItem_): String;
+begin
+  raise Exception.Create('Method not redefined');
+  Result := '';
+end;
+
+{--- TGenVector.SetOnItemToString ---}
+procedure TGenVector.SetOnItemToString(AValue: TItemToString);
+begin
+  if AValue = nil then
+    fOnItemToString := @DefaultItemToString
+  else
+    fOnItemToString := AValue;
+end;
+
+end.