mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-11 10:29:21 +02:00
* accept with statements with generic variables having a generic parameter type, resolves #21329
git-svn-id: trunk@23243 -
This commit is contained in:
parent
cd0c8a173e
commit
728c074bd6
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -10965,6 +10965,7 @@ tests/test/tgeneric89.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric9.pp svneol=native#text/plain
|
||||
tests/test/tgeneric90.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric91.pp svneol=native#text/pascal
|
||||
tests/test/tgeneric92.pp svneol=native#text/pascal
|
||||
tests/test/tgoto.pp svneol=native#text/plain
|
||||
tests/test/theap.pp svneol=native#text/plain
|
||||
tests/test/theapthread.pp svneol=native#text/plain
|
||||
@ -12973,6 +12974,7 @@ tests/webtbs/tw2128.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2129.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2129b.pp svneol=native#text/plain
|
||||
tests/webtbs/tw2131.pp svneol=native#text/plain
|
||||
tests/webtbs/tw21329.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21350a.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21350b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw21443.pp svneol=native#text/plain
|
||||
|
@ -1776,6 +1776,17 @@ implementation
|
||||
mayberesettypeconvs;
|
||||
exit;
|
||||
end;
|
||||
nothingn :
|
||||
begin
|
||||
{ generics can generate nothing nodes, just allow everything }
|
||||
if df_generic in current_procinfo.procdef.defoptions then
|
||||
result:=true
|
||||
else if report_errors then
|
||||
CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
|
||||
|
||||
mayberesettypeconvs;
|
||||
exit;
|
||||
end;
|
||||
loadn :
|
||||
begin
|
||||
case tloadnode(hp).symtableentry.typ of
|
||||
|
@ -2113,6 +2113,22 @@ implementation
|
||||
---------------------------------------------}
|
||||
|
||||
procedure factor_read_id(out p1:tnode;var again:boolean);
|
||||
|
||||
function findwithsymtable : boolean;
|
||||
var
|
||||
hp : psymtablestackitem;
|
||||
begin
|
||||
result:=true;
|
||||
hp:=symtablestack.stack;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if hp^.symtable.symtabletype=withsymtable then
|
||||
exit;
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
result:=false;
|
||||
end;
|
||||
|
||||
var
|
||||
srsym : tsym;
|
||||
srsymtable : TSymtable;
|
||||
@ -2192,9 +2208,21 @@ implementation
|
||||
symbol }
|
||||
not (sp_explicitrename in srsym.symoptions) then
|
||||
begin
|
||||
identifier_not_found(orgstoredpattern);
|
||||
srsym:=generrorsym;
|
||||
srsymtable:=nil;
|
||||
{ if a generic is parsed and when we are inside an with block,
|
||||
a symbol might not be defined }
|
||||
if (df_generic in current_procinfo.procdef.defoptions) and
|
||||
findwithsymtable then
|
||||
begin
|
||||
{ create dummy symbol, it will be freed later on }
|
||||
srsym:=tsym.create(undefinedsym,'$undefinedsym');
|
||||
srsymtable:=nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
identifier_not_found(orgstoredpattern);
|
||||
srsym:=generrorsym;
|
||||
srsymtable:=nil;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -2411,6 +2439,14 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
undefinedsym :
|
||||
begin
|
||||
p1:=cnothingnode.Create;
|
||||
p1.resultdef:=tundefineddef.create;
|
||||
{ clean up previously created dummy symbol }
|
||||
srsym.free;
|
||||
end;
|
||||
|
||||
errorsym :
|
||||
begin
|
||||
p1:=cerrornode.create;
|
||||
|
@ -534,7 +534,6 @@ implementation
|
||||
hp,
|
||||
refnode : tnode;
|
||||
hdef : tdef;
|
||||
extendeddef : tabstractrecorddef;
|
||||
helperdef : tobjectdef;
|
||||
hasimplicitderef : boolean;
|
||||
withsymtablelist : TFPObjectList;
|
||||
@ -579,7 +578,8 @@ implementation
|
||||
to call it in case it returns a record/object/... }
|
||||
maybe_call_procvar(p,false);
|
||||
|
||||
if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) then
|
||||
if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) or
|
||||
((p.resultdef.typ=undefineddef) and (df_generic in current_procinfo.procdef.defoptions)) then
|
||||
begin
|
||||
newblock:=nil;
|
||||
valuenode:=nil;
|
||||
@ -660,21 +660,15 @@ implementation
|
||||
valuenode));
|
||||
typecheckpass(refnode);
|
||||
end;
|
||||
|
||||
{ do we have a helper for this type? }
|
||||
if p.resultdef.typ=classrefdef then
|
||||
extendeddef:=tobjectdef(tclassrefdef(p.resultdef).pointeddef)
|
||||
else
|
||||
extendeddef:=tabstractrecorddef(p.resultdef);
|
||||
search_last_objectpascal_helper(extendeddef,current_structdef,helperdef);
|
||||
{ Note: the symtable of the helper is pushed after the following
|
||||
"case", the symtables of the helper's parents are passed in
|
||||
the "case" branches }
|
||||
|
||||
withsymtablelist:=TFPObjectList.create(true);
|
||||
case p.resultdef.typ of
|
||||
objectdef :
|
||||
begin
|
||||
{ do we have a helper for this type? }
|
||||
search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef);
|
||||
{ push symtables of all parents in reverse order }
|
||||
pushobjchild(tobjectdef(p.resultdef),tobjectdef(p.resultdef).childof);
|
||||
{ push symtables of all parents of the helper in reverse order }
|
||||
@ -687,6 +681,8 @@ implementation
|
||||
end;
|
||||
classrefdef :
|
||||
begin
|
||||
{ do we have a helper for this type? }
|
||||
search_last_objectpascal_helper(tobjectdef(tclassrefdef(p.resultdef).pointeddef),current_structdef,helperdef);
|
||||
{ push symtables of all parents in reverse order }
|
||||
pushobjchild(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).childof);
|
||||
{ push symtables of all parents of the helper in reverse order }
|
||||
@ -699,6 +695,8 @@ implementation
|
||||
end;
|
||||
recorddef :
|
||||
begin
|
||||
{ do we have a helper for this type? }
|
||||
search_last_objectpascal_helper(tabstractrecorddef(p.resultdef),current_structdef,helperdef);
|
||||
{ push symtables of all parents of the helper in reverse order }
|
||||
if assigned(helperdef) then
|
||||
pushobjchild(helperdef,helperdef.childof);
|
||||
@ -707,6 +705,16 @@ implementation
|
||||
symtablestack.push(st);
|
||||
withsymtablelist.add(st);
|
||||
end;
|
||||
undefineddef :
|
||||
begin
|
||||
if not(df_generic in current_procinfo.procdef.defoptions) then
|
||||
internalerror(2012122802);
|
||||
helperdef:=nil;
|
||||
{ push record symtable }
|
||||
st:=twithsymtable.create(p.resultdef,nil,refnode);
|
||||
symtablestack.push(st);
|
||||
withsymtablelist.add(st);
|
||||
end;
|
||||
else
|
||||
internalerror(200601271);
|
||||
end;
|
||||
|
@ -548,7 +548,7 @@ type
|
||||
staticvarsym,localvarsym,paravarsym,fieldvarsym,
|
||||
typesym,procsym,unitsym,constsym,enumsym,
|
||||
errorsym,syssym,labelsym,absolutevarsym,propertysym,
|
||||
macrosym,namespacesym
|
||||
macrosym,namespacesym,undefinedsym
|
||||
);
|
||||
|
||||
{ State of the variable:
|
||||
@ -662,7 +662,7 @@ inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has
|
||||
'abstractsym','globalvar','localvar','paravar','fieldvar',
|
||||
'type','proc','unit','const','enum',
|
||||
'errorsym','system sym','label','absolutevar','property',
|
||||
'macrosym','namespace'
|
||||
'macrosym','namespace','undefinedsym'
|
||||
);
|
||||
|
||||
typName : array[tdeftyp] of string[12] = (
|
||||
|
@ -2292,7 +2292,8 @@ implementation
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
else if not((srsymtable.symtabletype=withsymtable) and assigned(srsymtable.defowner) and
|
||||
(srsymtable.defowner.typ=undefineddef)) then
|
||||
begin
|
||||
srsym:=tsym(srsymtable.FindWithHash(hashedid));
|
||||
if assigned(srsym) then
|
||||
|
24
tests/test/tgeneric92.pp
Normal file
24
tests/test/tgeneric92.pp
Normal file
@ -0,0 +1,24 @@
|
||||
{$mode objfpc}
|
||||
type
|
||||
TRec = record
|
||||
i : longint;
|
||||
end;
|
||||
|
||||
generic TGeneric<T>=class(TObject)
|
||||
procedure Test(v : T);
|
||||
end;
|
||||
|
||||
procedure TGeneric.Test(v : T);
|
||||
begin
|
||||
with v do
|
||||
begin
|
||||
i:=1;
|
||||
end;
|
||||
end;
|
||||
|
||||
type
|
||||
TC = specialize TGeneric<TRec>;
|
||||
|
||||
begin
|
||||
end.
|
||||
|
29
tests/webtbs/tw21329.pp
Normal file
29
tests/webtbs/tw21329.pp
Normal file
@ -0,0 +1,29 @@
|
||||
{$MODE DELPHI}
|
||||
{$DEFINE CAUSE_ERROR}
|
||||
|
||||
type
|
||||
TArray<T> = array of T;
|
||||
|
||||
TRecord = record end;
|
||||
|
||||
TWrapper<T> = class
|
||||
strict private
|
||||
{$IFDEF CAUSE_ERROR}
|
||||
FRecords: TArray<TRecord>;
|
||||
{$ELSE}
|
||||
FRecords: array of TRecord;
|
||||
{$ENDIF}
|
||||
public
|
||||
constructor Create;
|
||||
end;
|
||||
|
||||
constructor TWrapper<T>.Create;
|
||||
begin
|
||||
SetLength(FRecords, 1);
|
||||
with FRecords[0] do;
|
||||
// FRecords[0].x:=1;
|
||||
end;
|
||||
|
||||
begin
|
||||
TWrapper<TRecord>.Create.Free;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user