mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 22:47:59 +02:00
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:
parent
12f5cb85e8
commit
aca48a4cf2
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -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
|
||||
|
@ -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
54
tests/webtbs/tw26288.pp
Normal 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.
|
Loading…
Reference in New Issue
Block a user