paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 18:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: specialize try-except

Browse Source 
git-svn-id: trunk@42680 -
This commit is contained in:
Mattias Gaertner 2019-08-13 19:43:05 +00:00
parent 85edf1c1eb
commit 10ffed0528
3 changed files with 62 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
packages/fcl-passrc/src/pasresolver.pp
View File

@ -15122,7 +15122,10 @@ begin
or (C=TPasImplTryExceptElse) then or (C=TPasImplTryExceptElse) then
SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl)) SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
else if C=TPasImplExceptOn then else if C=TPasImplExceptOn then
SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl)) begin
AddExceptOn(TPasImplExceptOn(SpecEl));
SpecializeImplExceptOn(TPasImplExceptOn(GenEl),TPasImplExceptOn(SpecEl));
end
else if C=TPasImplRaise then else if C=TPasImplRaise then
SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl)) SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
// declaration // declaration
@ -15245,6 +15248,8 @@ begin
or (GenElType.ClassType=TPasGenericTemplateType) then or (GenElType.ClassType=TPasGenericTemplateType) then
begin begin
// reference // reference
if GenElType.Name='' then
RaiseNotYetImplemented(20190813213555,GenEl,GetObjName(GenElType)+' Parent='+GetObjName(GenElType.Parent));
Ref:=FindElement(GenElType.Name); Ref:=FindElement(GenElType.Name);
if not (Ref is TPasType) then if not (Ref is TPasType) then
RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref)); RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref));
@ -15677,13 +15682,11 @@ procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
begin begin
SpecializeImplBlock(GenEl,SpecEl); // clone elements SpecializeImplBlock(GenEl,SpecEl); // clone elements
if GenEl.FinallyExcept<>nil then if GenEl.FinallyExcept<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.FinallyExcept, SpecializeElImplEl(GenEl,SpecEl,GenEl.FinallyExcept,
TPasImplElement(SpecEl.FinallyExcept) TPasImplElement(SpecEl.FinallyExcept));
{$IFDEF CheckPasTreeRefCount},'TPasImplTry.FinallyExcept'{$ENDIF});
if GenEl.ElseBranch<>nil then if GenEl.ElseBranch<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch, SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,
TPasImplElement(SpecEl.ElseBranch) TPasImplElement(SpecEl.ElseBranch));
{$IFDEF CheckPasTreeRefCount},'TPasImplTry.ElseBranch'{$ENDIF});
end; end;
procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn); procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
@ -18271,7 +18274,7 @@ begin
{AllowWriteln-} {AllowWriteln-}
{$ENDIF} {$ENDIF}
if not IsValidIdent(CurName) then if not IsValidIdent(CurName) then
RaiseNotYetImplemented(20170328000033,ErrorEl); RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
if CurScopeEl<>nil then if CurScopeEl<>nil then
begin begin
NeedPop:=true; NeedPop:=true;
@ -20064,7 +20067,7 @@ var
begin begin
s:=sNotYetImplemented+' ['+IntToStr(id)+']'; s:=sNotYetImplemented+' ['+IntToStr(id)+']';
if Msg<>'' then if Msg<>'' then
s:=s+' '+Msg; s:=s+' "'+Msg+'"';
{$IFDEF VerbosePasResolver} {$IFDEF VerbosePasResolver}
writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El)); writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
{$ENDIF} {$ENDIF}

9
packages/fcl-passrc/src/pparser.pp
View File

@ -5735,6 +5735,7 @@ var
Name: String; Name: String;
TypeEl: TPasType; TypeEl: TPasType;
ImplRaise: TPasImplRaise; ImplRaise: TPasImplRaise;
VarEl: TPasVariable;
begin begin
NewImplElement:=nil; NewImplElement:=nil;
@ -6184,10 +6185,12 @@ begin
NextToken; NextToken;
TypeEl:=ParseSimpleType(El,SrcPos,''); TypeEl:=ParseSimpleType(El,SrcPos,'');
TPasImplExceptOn(El).TypeEl:=TypeEl; TPasImplExceptOn(El).TypeEl:=TypeEl;
TPasImplExceptOn(El).VarEl:=TPasVariable(CreateElement(TPasVariable, VarEl:=TPasVariable(CreateElement(TPasVariable,Name,El,SrcPos));
Name,El,SrcPos)); TPasImplExceptOn(El).VarEl:=VarEl;
TPasImplExceptOn(El).VarEl.VarType:=TypeEl; VarEl.VarType:=TypeEl;
TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF}; TypeEl.AddRef{$IFDEF CheckPasTreeRefCount}('TPasVariable.VarType'){$ENDIF};
if TypeEl.Parent=El then
TypeEl.Parent:=VarEl;
end end
else else
begin begin

45
packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -83,7 +83,7 @@ type
procedure TestGen_LocalVar; procedure TestGen_LocalVar;
procedure TestGen_Statements; procedure TestGen_Statements;
// ToDo: for-in // ToDo: for-in
// ToDo: try finally/except procedure TestGen_TryExcept;
// ToDo: call // ToDo: call
// ToDo: dot // ToDo: dot
// ToDo: is as // ToDo: is as
@ -725,6 +725,49 @@ begin
ParseProgram; ParseProgram;
end; end;
procedure TTestResolveGenerics.TestGen_TryExcept;
begin
StartProgram(false);
Add([
'{$mode objfpc}',
'type',
' TObject = class end;',
' generic TBird<{#Templ}T> = class',
' function Fly(p:T): T;',
' end;',
' Exception = class',
' end;',
' generic EMsg<T> = class',
' Msg: T;',
' end;',
'function TBird.Fly(p:T): T;',
'var',
' v1,v2,v3:T;',
'begin',
' try',
' finally',
' end;',
' try',
' v1:=v2;',
' finally',
' v2:=v1;',
' end;',
' try',
' except',
' on Exception do ;',
' on E: Exception do ;',
' on E: EMsg<boolean> do E.Msg:=true;',
' on E: EMsg<T> do E.Msg:=1;',
' end;',
'end;',
'var',
' b: specialize TBird<word>;',
'begin',
' b.Fly(2);',
'']);
ParseProgram;
end;
initialization initialization
RegisterTests([TTestResolveGenerics]); RegisterTests([TTestResolveGenerics]);