administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(const): integer literals and ranges in const-decl set literals

Browse source 
A typed set constant accepted only enum-member identifiers — `const C: TByteSet =
[1, 2, 3]` and `[1..3]` both failed with "Expected set member identifier". The
const-decl set path (a separate, more limited parser than the expression set
literal) is extended to accept:

* integer-literal members (1, 2, 3),
* inclusive ranges `lo..hi` (each endpoint an integer literal, enum member, or
  named constant), expanded to all ordinals in range,
* and ordinal base types (set of Byte / Boolean), not just enums.

Parser stores each member verbatim (a range as 'lo..hi'); the semantic pass
(AnalyseSetConstDecl) resolves and expands them via a new ResolveSetMemberOrd
helper, integrating with the existing small-mask and jumbo byte-bitmap const
machinery. Enum-member const sets (the original form) still work.

Adds dual-backend e2e coverage including edge cases: mixed range+literal, a jumbo
(>64-member) set with a range, the empty set, descending-range rejection, and an
enum-set regression. All three fixpoints green; 3495 tests pass.
This commit is contained in:
Graeme Geldenhuys 2026-06-18 11:08:00 +01:00
parent 6289a5235e
commit 517ed26f5d
3 changed files with 171 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
compiler/src/main/pascal/uParser.pas
View file

@ -1208,6 +1208,7 @@ procedure TParser.ParseConstValue(CD: TConstDecl);
var
CastVal: Int64;
FirstOperand: string;
ElemStr: string;
begin
{ Array const value list: flat (e, e, ...) or nested ((..),(..)). }
if CD.IsArrayConst then
@ -1321,20 +1322,40 @@ begin
else if Check(tkLBracket) then
begin
{ Set-valued constant: const Name [: SetType] = [member, member, ...]
or the empty set []. Members are enum-constant identifiers; semantic
resolves their ordinals and folds the bitmask. }
or the empty set []. A member is an enum-constant identifier, an integer
literal, or an inclusive range `lo..hi` (either endpoint an identifier or
an integer literal). Each member is stored as a string in SetElements; a
range is stored as the two endpoints joined by '..' so the semantic pass
(AnalyseSetConstDecl) can resolve and expand it. Semantic folds the
bitmask. }
CD.IsSet := True;
CD.SetElements := TStringList.Create();
Advance(); { consume '[' }
if not Check(tkRBracket) then
while True do
begin
if not Check(tkIdent) then
if Check(tkIdent) then
ElemStr := FCurrent.Value
else if Check(tkIntLit) then
ElemStr := FCurrent.Value
else
raise EParseError.Create(Format(
'Expected set member identifier at line %d col %d in %s',
'Expected set member (identifier or integer) at line %d col %d in %s',
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
CD.SetElements.Add(FCurrent.Value);
Advance();
{ Optional range continuation: lo..hi. }
if Check(tkDotDot) then
begin
Advance();
if Check(tkIdent) or Check(tkIntLit) then
ElemStr := ElemStr + '..' + FCurrent.Value
else
raise EParseError.Create(Format(
'Expected set range upper bound at line %d col %d in %s',
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
Advance();
end;
CD.SetElements.Add(ElemStr);
if Check(tkComma) then
Advance()
else

71
compiler/src/main/pascal/uSemantic.pas
View file

@ -153,6 +153,8 @@ type
{ Resolve a set-valued const decl (IsSet): fold the member bitmask into
CD.IntVal and register the const symbol with its tySet type. }
procedure AnalyseSetConstDecl(ACD: TConstDecl);
function ResolveSetMemberOrd(const AMember: string; ACD: TConstDecl;
var AEnumDesc: TEnumTypeDesc): Integer;
procedure AnalyseArrayConstDecls(ABlock: TBlock);
{ Build the (possibly nested) static-array type for a range-indexed array
const and validate that the flat row-major element count matches the
@ -3968,6 +3970,38 @@ begin
ALine, ACol);
end;
function TSemanticAnalyser.ResolveSetMemberOrd(const AMember: string;
ACD: TConstDecl; var AEnumDesc: TEnumTypeDesc): Integer;
{ Resolve one set-constant member (an integer literal, an enum constant, or a
named integer constant) to its ordinal. Enum members must all share one base
enum, tracked through AEnumDesc; integer members do not set it (the set's base
type then comes from the declared TypeName, e.g. set of Byte). }
var
Sym: TSymbol;
begin
if IsPlainInt(AMember) then
Exit(Integer(StrToInt(AMember)));
Sym := FTable.Lookup(AMember);
if (Sym = nil) or (Sym.Kind <> skConstant) then
begin
SemanticError(Format(
'Set constant ''%s'' member ''%s'' is not a constant value',
[ACD.Name, AMember]), ACD.Line, ACD.Col);
Exit(0);
end;
{ Enum member: pin / check the shared base enum. }
if (Sym.TypeDesc <> nil) and (Sym.TypeDesc.Kind = tyEnum) then
begin
if AEnumDesc = nil then
AEnumDesc := TEnumTypeDesc(Sym.TypeDesc)
else if Sym.TypeDesc <> AEnumDesc then
SemanticError(Format(
'Set constant ''%s'' mixes members of ''%s'' and ''%s''',
[ACD.Name, AEnumDesc.Name, Sym.TypeDesc.Name]), ACD.Line, ACD.Col);
end;
Result := Integer(Sym.ConstValue);
end;
procedure TSemanticAnalyser.AnalyseSetConstDecl(ACD: TConstDecl);
var
I: Integer;
@ -3982,6 +4016,8 @@ var
Sym: TSymbol;
Ords: TStringList;
Ord, BIdx, NB, BVal: Integer;
DotPos, Lo, Hi: Integer;
LoStr, HiStr: string;
begin
Mask := 0;
EnumDesc := nil;
@ -3994,25 +4030,24 @@ begin
for I := 0 to ACD.SetElements.Count - 1 do
begin
MemName := ACD.SetElements.Strings[I];
MemSym := FTable.Lookup(MemName);
if (MemSym = nil) or (MemSym.Kind <> skConstant) or
(MemSym.TypeDesc = nil) or (MemSym.TypeDesc.Kind <> tyEnum) then
DotPos := Pos('..', MemName);
if DotPos >= 0 then
begin
SemanticError(Format(
'Set constant ''%s'' member ''%s'' is not an enum constant',
[ACD.Name, MemName]), ACD.Line, ACD.Col);
Exit;
end;
if EnumDesc = nil then
EnumDesc := TEnumTypeDesc(MemSym.TypeDesc)
else if MemSym.TypeDesc <> EnumDesc then
begin
SemanticError(Format(
'Set constant ''%s'' mixes members of ''%s'' and ''%s''',
[ACD.Name, EnumDesc.Name, MemSym.TypeDesc.Name]), ACD.Line, ACD.Col);
Exit;
end;
Ords.Add(IntToStr(MemSym.ConstValue));
{ Inclusive range lo..hi — resolve both endpoints to ordinals and add
every value in between. }
LoStr := Copy(MemName, 0, DotPos);
HiStr := Copy(MemName, DotPos + 2, Length(MemName) - DotPos - 2);
Lo := Self.ResolveSetMemberOrd(LoStr, ACD, EnumDesc);
Hi := Self.ResolveSetMemberOrd(HiStr, ACD, EnumDesc);
if Hi < Lo then
SemanticError(Format(
'Set constant ''%s'' range %s..%s is descending', [ACD.Name, LoStr, HiStr]),
ACD.Line, ACD.Col);
for Ord := Lo to Hi do
Ords.Add(IntToStr(Ord));
end
else
Ords.Add(IntToStr(Self.ResolveSetMemberOrd(MemName, ACD, EnumDesc)));
end;
{ Determine the set type descriptor. }

92
compiler/src/test/pascal/cp.test.e2e.sets.pas
View file

@ -53,6 +53,13 @@ type
procedure TestRun_SetOfByte_InOperator;
procedure TestRun_SetOfByte_RangeLiteral;
procedure TestRun_SetOfByte_Union;
{ const-decl set literals: integer literals + ranges (not just enum idents) }
procedure TestRun_ConstSet_IntLiterals;
procedure TestRun_ConstSet_IntRange;
procedure TestRun_ConstSet_MixedRangeAndLiteral;
procedure TestRun_ConstSet_JumboWithRange;
procedure TestRun_ConstSet_EnumStillWorks;
end;
implementation
@ -472,6 +479,91 @@ begin
'1' + LE + '2' + LE + '3' + LE, 0);
end;
{ ---- const-decl set literals (integer literals + ranges) ---- }
procedure TE2ESetOpsTests.TestRun_ConstSet_IntLiterals;
const Src = '''
program P;
type TByteSet = set of Byte;
const C: TByteSet = [1, 2, 3];
begin
if 2 in C then WriteLn('y') else WriteLn('n');
if 5 in C then WriteLn('y') else WriteLn('n')
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'y' + LE + 'n' + LE, 0);
end;
procedure TE2ESetOpsTests.TestRun_ConstSet_IntRange;
const Src = '''
program P;
type TByteSet = set of Byte;
const C: TByteSet = [1..3];
var I: Integer;
begin
for I := 0 to 4 do
if I in C then WriteLn('y') else WriteLn('n')
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'n' + LE + 'y' + LE + 'y' + LE + 'y' + LE + 'n' + LE, 0);
end;
procedure TE2ESetOpsTests.TestRun_ConstSet_MixedRangeAndLiteral;
const Src = '''
program P;
type TByteSet = set of Byte;
const C: TByteSet = [10..12, 20];
begin
if 11 in C then WriteLn('y') else WriteLn('n');
if 20 in C then WriteLn('y') else WriteLn('n');
if 15 in C then WriteLn('y') else WriteLn('n')
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'y' + LE + 'y' + LE + 'n' + LE, 0);
end;
procedure TE2ESetOpsTests.TestRun_ConstSet_JumboWithRange;
{ Edge case: a jumbo (>64-member) Byte set built from a const with a range and
high values — exercises the byte-bitmap const path. }
const Src = '''
program P;
type TByteSet = set of Byte;
const C: TByteSet = [200, 201..205, 0];
begin
if 203 in C then WriteLn('y') else WriteLn('n');
if 0 in C then WriteLn('y') else WriteLn('n');
if 100 in C then WriteLn('y') else WriteLn('n')
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'y' + LE + 'y' + LE + 'n' + LE, 0);
end;
procedure TE2ESetOpsTests.TestRun_ConstSet_EnumStillWorks;
{ Regression: enum-member const sets (the original supported form) still work. }
const Src = '''
program P;
type
TColor = (Red, Green, Blue, Yellow);
TColors = set of TColor;
const Warm: TColors = [Red, Yellow];
begin
if Red in Warm then WriteLn('y') else WriteLn('n');
if Green in Warm then WriteLn('y') else WriteLn('n')
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(Src, 'y' + LE + 'n' + LE, 0);
end;
initialization
RegisterTest(TE2ESetOpsTests);