mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-05 20:38:28 +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/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
|
||||||
|
@ -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
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