paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 21:07:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

pasresolver: fixed const c=[enum..enum]

Browse Source 
git-svn-id: trunk@35870 -
This commit is contained in:
Mattias Gaertner 2017-04-21 09:09:31 +00:00
parent cbeead79ec
commit 5b98efe397
2 changed files with 41 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1407,7 +1407,6 @@ type
function CheckEqualResCompatibility(const LHS, RHS: TPasResolverResult;
LErrorEl: TPasElement; RaiseOnIncompatible: boolean;
RErrorEl: TPasElement = nil): integer;
function ResolvedElHasValue(const ResolvedEl: TPasResolverResult): boolean;
function ResolvedElCanBeVarParam(const ResolvedEl: TPasResolverResult): boolean;
function ResolvedElIsClassInstance(const ResolvedEl: TPasResolverResult): boolean;
// uility functions
@ -5310,7 +5309,7 @@ begin
if ResolvedValue.BaseType in btAllStrings then
begin
// string -> check that ResolvedValue is not merely a type, but has a value
if not ResolvedElHasValue(ResolvedValue) then
if not (rrfReadable in ResolvedValue.Flags) then
RaiseXExpectedButYFound(20170216152548,'variable',ResolvedValue.TypeEl.ElementTypeName,Params);
// check single argument
if length(Params.Params)<1 then
@ -6712,14 +6711,14 @@ var
LBT, RBT: TResolverBaseType;
begin
// check both are values
if not ResolvedElHasValue(LHS) then
if not (rrfReadable in LHS.Flags) then
begin
if LHS.TypeEl<>nil then
RaiseXExpectedButYFound(20170216152645,'ordinal',LHS.TypeEl.ElementTypeName,Left)
else
RaiseXExpectedButYFound(20170216152648,'ordinal',BaseTypeNames[LHS.BaseType],Left);
end;
if not ResolvedElHasValue(RHS) then
if not (rrfReadable in RHS.Flags) then
begin
if RHS.TypeEl<>nil then
RaiseXExpectedButYFound(20170216152651,'ordinal',RHS.TypeEl.ElementTypeName,Right)
@ -9987,19 +9986,6 @@ begin
RaiseNotYetImplemented(20161007101041,LErrorEl,'LHS='+GetResolverResultDbg(LHS)+' RHS='+GetResolverResultDbg(RHS));
end;
function TPasResolver.ResolvedElHasValue(const ResolvedEl: TPasResolverResult
): boolean;
begin
if not (rrfReadable in ResolvedEl.Flags) then
Result:=false
else if ResolvedEl.ExprEl<>nil then
Result:=true
else if (ResolvedEl.IdentEl<>nil) then
Result:=not (ResolvedEl.IdentEl is TPasType)
else
Result:=false;
end;
function TPasResolver.ResolvedElCanBeVarParam(
const ResolvedEl: TPasResolverResult): boolean;
begin

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

@ -183,6 +183,7 @@ type
Procedure TestArgWrongExprFail;
Procedure TestVarExternal;
Procedure TestVarNoSemicolonBeginFail;
Procedure TestIntegerRange;
// strings
Procedure TestChar_Ord;
@ -198,7 +199,6 @@ type
// enums
Procedure TestEnums;
Procedure TestSets;
Procedure TestSetConstRange;
Procedure TestSetOperators;
Procedure TestEnumParams;
Procedure TestSetParams;
@ -209,6 +209,7 @@ type
Procedure TestEnum_EqualNilFail;
Procedure TestEnum_CastIntegerToEnum;
Procedure TestEnum_Str;
Procedure TestSetConstRange;
Procedure TestSet_AnonymousEnumtype;
Procedure TestSet_AnonymousEnumtypeName;
@ -2071,6 +2072,16 @@ begin
nParserExpectTokenError);
end;
procedure TTestResolver.TestIntegerRange;
begin
StartProgram(false);
Add('const');
Add(' MinInt = -1;');
Add(' MaxInt = +1;');
Add(' {#TMyInt}TMyInt = MinInt..MaxInt;');
Add('begin');
end;
procedure TTestResolver.TestChar_Ord;
begin
StartProgram(false);
@ -2236,16 +2247,6 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestSetConstRange;
begin
StartProgram(false);
Add('const');
Add(' MinInt = -1;');
Add(' MaxInt = +1;');
Add(' {#TMyInt}TMyInt = MinInt..MaxInt;');
Add('begin');
end;
procedure TTestResolver.TestSetOperators;
begin
StartProgram(false);
@ -2461,6 +2462,32 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestSetConstRange;
begin
StartProgram(false);
Add([
'type',
' TEnum = (red,blue,green);',
' TEnums = set of TEnum;',
'const',
' teAny = [low(TEnum)..high(TEnum)];',
' teRedBlue = [low(TEnum)..pred(high(TEnum))];',
'var',
' e: TEnum;',
' s: TEnums;',
'begin',
' if blue in teAny then;',
' if blue in teAny+[e] then;',
' if blue in teAny+teRedBlue then;',
' s:=teAny;',
' s:=teAny+[e];',
' s:=[e]+teAny;',
' s:=teAny+teRedBlue;',
' s:=teAny+teRedBlue+[e];',
'']);
ParseProgram;
end;
procedure TTestResolver.TestSet_AnonymousEnumtype;
begin
StartProgram(false);