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 -
This commit is contained in:
svenbarth 2014-06-06 14:22:17 +00:00
parent 12f5cb85e8
commit aca48a4cf2
3 changed files with 61 additions and 2 deletions

1
.gitattributes vendored
View File

@ -13945,6 +13945,7 @@ tests/webtbs/tw26230.pp svneol=native#text/plain
tests/webtbs/tw2626.pp svneol=native#text/plain
tests/webtbs/tw2627.pp svneol=native#text/plain
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/tw26408.pp svneol=native#text/pascal
tests/webtbs/tw2643.pp svneol=native#text/plain

View File

@ -1262,7 +1262,9 @@ implementation
in both cases we need "parse_generic" and "current_genericdef"
so that e.g. specializations of another generic inside the
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
current_genericdef:=old_current_genericdef;
@ -1426,7 +1428,9 @@ implementation
in both cases we need "parse_generic" and "current_genericdef"
so that e.g. specializations of another generic inside the
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
current_genericdef:=old_current_genericdef;
{ don't allow to add defs to the symtable - use it for type param search only }

54
tests/webtbs/tw26288.pp Normal file
View File

@ -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.