paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-16 19:20:46 +01:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: resolver: raise functioncall

Browse Source 
git-svn-id: trunk@37432 -
This commit is contained in:
Mattias Gaertner 2017-10-09 10:44:15 +00:00
parent 243002023c
commit 40b359c1ba
2 changed files with 59 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5111,10 +5111,16 @@ begin
if ResolvedEl.IdentEl<>nil then if ResolvedEl.IdentEl<>nil then
begin begin
if (ResolvedEl.IdentEl is TPasVariable) if (ResolvedEl.IdentEl is TPasVariable)
or (ResolvedEl.IdentEl is TPasArgument) then or (ResolvedEl.IdentEl is TPasArgument)
or (ResolvedEl.IdentEl is TPasResultElement) then
else else
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
{$ENDIF}
RaiseMsg(20170216152133,nXExpectedButYFound,sXExpectedButYFound, RaiseMsg(20170216152133,nXExpectedButYFound,sXExpectedButYFound,
['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject); ['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject);
end;
end end
else if ResolvedEl.ExprEl<>nil then else if ResolvedEl.ExprEl<>nil then
else else
@ -11385,6 +11391,7 @@ begin
begin begin
LBT:=GetActualBaseType(LHS.BaseType); LBT:=GetActualBaseType(LHS.BaseType);
RBT:=GetActualBaseType(RHS.BaseType); RBT:=GetActualBaseType(RHS.BaseType);
writeln('AAA1 TPasResolver.CheckAssignResCompatibility ',lbt,' ',rbt);
if LHS.TypeEl=nil then if LHS.TypeEl=nil then
begin begin
if LBT=btUntyped then if LBT=btUntyped then
@ -11515,7 +11522,14 @@ begin
[],ErrorEl); [],ErrorEl);
exit(cIncompatible); exit(cIncompatible);
end end
else if LBT in [btRange,btSet,btModule,btProc] then else if LBT=btRange then
begin
// ToDo:
if RaiseOnIncompatible then
RaiseMsg(20171006004132,nIllegalExpression,sIllegalExpression,[],ErrorEl);
exit(cIncompatible);
end
else if LBT in [btSet,btModule,btProc] then
begin begin
if RaiseOnIncompatible then if RaiseOnIncompatible then
RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl); RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);

55
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -239,6 +239,7 @@ type
Procedure TestEnumSet_AnonymousEnumtypeName; Procedure TestEnumSet_AnonymousEnumtypeName;
Procedure TestEnumSet_Const; Procedure TestEnumSet_Const;
Procedure TestSet_IntRange_Const; Procedure TestSet_IntRange_Const;
Procedure TestEnumRange; // ToDo
// operators // operators
Procedure TestPrgAssignment; Procedure TestPrgAssignment;
@ -3076,15 +3077,34 @@ begin
Add([ Add([
'type', 'type',
' TIntRg = 2..6;', ' TIntRg = 2..6;',
' TSevenSet = set of TIntRg;', ' TFiveSet = set of TIntRg;',
'const', 'const',
' a: TSevenSet = [2..3,5]+[4];', ' a: TFiveSet = [2..3,5]+[4];',
' b = low(TIntRg)+high(TIntRg);', ' b = low(TIntRg)+high(TIntRg);',
'begin']); 'begin']);
ParseProgram; ParseProgram;
CheckResolverUnexpectedHints; CheckResolverUnexpectedHints;
end; end;
procedure TTestResolver.TestEnumRange;
begin
exit;
StartProgram(false);
Add([
'type',
' TEnum = (a,b,c,d,e);',
' TEnumRg = b..d;',
'const',
' c1: TEnumRg = c;',
' c2 = succ(low(TEnumRg));',
' c3 = pred(high(TEnumRg));',
' c4 = TEnumRg(2);',
'begin']);
ParseProgram;
// see also: TestPropertyDefaultValue
CheckResolverUnexpectedHints;
end;
procedure TTestResolver.TestPrgAssignment; procedure TTestResolver.TestPrgAssignment;
var var
El: TPasElement; El: TPasElement;
@ -3901,15 +3921,23 @@ var
Ref: TResolvedReference; Ref: TResolvedReference;
begin begin
StartProgram(false); StartProgram(false);
Add('type'); Add([
Add(' TObject = class'); 'type',
Add(' constructor Create(Msg: string); external name ''ext'';'); ' TObject = class',
Add(' end;'); ' constructor Create(Msg: string); external name ''ext'';',
Add(' Exception = class end;'); ' end;',
Add(' EConvertError = class(Exception) end;'); ' Exception = class end;',
Add('begin'); ' EConvertError = class(Exception) end;',
Add(' raise Exception.{#a}Create(''foo'');'); 'function AssertConv(Msg: string = ''msg''): EConvertError;',
Add(' raise EConvertError.{#b}Create(''bar'');'); 'begin',
' Result:=EConvertError.{#ass}Create(Msg);',
'end;',
'begin',
' raise Exception.{#a}Create(''foo'');',
' raise EConvertError.{#b}Create(''bar'');',
' raise AssertConv(''c'');',
' raise AssertConv;',
'']);
ParseProgram; ParseProgram;
aMarker:=FirstSrcMarker; aMarker:=FirstSrcMarker;
while aMarker<>nil do while aMarker<>nil do
@ -8282,7 +8310,8 @@ begin
StartProgram(false); StartProgram(false);
Add([ Add([
'type', 'type',
' TEnum = (red, blue);', ' TEnum = (red, blue, green, white, grey, black);',
' TEnumRg = blue..grey;',
' TSet = set of TEnum;', ' TSet = set of TEnum;',
'const', 'const',
' CB = true or false;', ' CB = true or false;',
@ -8300,6 +8329,8 @@ begin
' FE: TEnum;', ' FE: TEnum;',
' property E1: TEnum read FE default red;', ' property E1: TEnum read FE default red;',
' property E2: TEnum read FE default TEnum.blue;', ' property E2: TEnum read FE default TEnum.blue;',
//' FEnumRg: TEnumRg;',
//' property EnumRg1: TEnumRg read FEnumRg default white;',
' FSet: TSet;', ' FSet: TSet;',
' property Set1: TSet read FSet default [];', ' property Set1: TSet read FSet default [];',
' property Set2: TSet read FSet default [red];', ' property Set2: TSet read FSet default [red];',