paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-27 05:32:28 +02: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
begin
if (ResolvedEl.IdentEl is TPasVariable)
or (ResolvedEl.IdentEl is TPasArgument) then
or (ResolvedEl.IdentEl is TPasArgument)
or (ResolvedEl.IdentEl is TPasResultElement) then
else
begin
{$IFDEF VerbosePasResolver}
writeln('TPasResolver.ResolveImplRaise ',GetResolverResultDbg(ResolvedEl));
{$ENDIF}
RaiseMsg(20170216152133,nXExpectedButYFound,sXExpectedButYFound,
['variable',ResolvedEl.IdentEl.ElementTypeName],El.ExceptObject);
end;
end
else if ResolvedEl.ExprEl<>nil then
else
@ -11385,6 +11391,7 @@ begin
begin
LBT:=GetActualBaseType(LHS.BaseType);
RBT:=GetActualBaseType(RHS.BaseType);
writeln('AAA1 TPasResolver.CheckAssignResCompatibility ',lbt,' ',rbt);
if LHS.TypeEl=nil then
begin
if LBT=btUntyped then
@ -11515,7 +11522,14 @@ begin
[],ErrorEl);
exit(cIncompatible);
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
if RaiseOnIncompatible then
RaiseMsg(20170216152432,nIllegalExpression,sIllegalExpression,[],ErrorEl);

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

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