paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 00:08:43 +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
SpecializeImplBlock(TPasImplCaseElse(GenEl),TPasImplCaseElse(SpecEl))
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
SpecializeImplRaise(TPasImplRaise(GenEl),TPasImplRaise(SpecEl))
// declaration
@ -15245,6 +15248,8 @@ begin
or (GenElType.ClassType=TPasGenericTemplateType) then
begin
// reference
if GenElType.Name='' then
RaiseNotYetImplemented(20190813213555,GenEl,GetObjName(GenElType)+' Parent='+GetObjName(GenElType.Parent));
Ref:=FindElement(GenElType.Name);
if not (Ref is TPasType) then
RaiseNotYetImplemented(20190812021538,GenEl,GetObjName(Ref));
@ -15677,13 +15682,11 @@ procedure TPasResolver.SpecializeImplTry(GenEl, SpecEl: TPasImplTry);
begin
SpecializeImplBlock(GenEl,SpecEl); // clone elements
if GenEl.FinallyExcept<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.FinallyExcept,
TPasImplElement(SpecEl.FinallyExcept)
{$IFDEF CheckPasTreeRefCount},'TPasImplTry.FinallyExcept'{$ENDIF});
SpecializeElImplEl(GenEl,SpecEl,GenEl.FinallyExcept,
TPasImplElement(SpecEl.FinallyExcept));
if GenEl.ElseBranch<>nil then
SpecializeElImplAlias(GenEl,SpecEl,GenEl.ElseBranch,
TPasImplElement(SpecEl.ElseBranch)
{$IFDEF CheckPasTreeRefCount},'TPasImplTry.ElseBranch'{$ENDIF});
SpecializeElImplEl(GenEl,SpecEl,GenEl.ElseBranch,
TPasImplElement(SpecEl.ElseBranch));
end;
procedure TPasResolver.SpecializeImplExceptOn(GenEl, SpecEl: TPasImplExceptOn);
@ -18271,7 +18274,7 @@ begin
{AllowWriteln-}
{$ENDIF}
if not IsValidIdent(CurName) then
RaiseNotYetImplemented(20170328000033,ErrorEl);
RaiseNotYetImplemented(20170328000033,ErrorEl,CurName);
if CurScopeEl<>nil then
begin
NeedPop:=true;
@ -20064,7 +20067,7 @@ var
begin
s:=sNotYetImplemented+' ['+IntToStr(id)+']';
if Msg<>'' then
s:=s+' '+Msg;
s:=s+' "'+Msg+'"';
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.RaiseNotYetImplemented s="',s,'" El=',GetObjName(El));
{$ENDIF}

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

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

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

@ -83,7 +83,7 @@ type
procedure TestGen_LocalVar;
procedure TestGen_Statements;
// ToDo: for-in
// ToDo: try finally/except
procedure TestGen_TryExcept;
// ToDo: call
// ToDo: dot
// ToDo: is as
@ -725,6 +725,49 @@ begin
ParseProgram;
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
RegisterTests([TTestResolveGenerics]);