feat(sets): subset/superset operators; reject enum-member shadowing

Two related set/enum fixes from shaking the sets cluster.

1. Set subset (<=) and superset (>=) operators, e.g. `if s <= t`:
   - Semantic: <= and >= on two sets yield Boolean (alongside =, <>).
   - Codegen both backends: non-jumbo sets test (s and not t)=0 for <=
     (operands swapped for >=); jumbo sets call a new RTL _SetSubset
     (added to blaise_set.pas) which returns whether every bit of A is in B.
   Completes the set-operator suite (+, -, *, in, =, <>, <=, >= now all work).

2. Reject a variable that shadows a visible enum member (e.g. `var c` when
   an enum member `C` is visible — Pascal is case-insensitive). Such a
   shadow silently retargeted the member in a set literal `[A, C, D]` to the
   variable: QBE errored with "Set literal element 'c' is not a constant",
   and — worse — the native backend produced a WRONG bitmask with no error
   (the member's bit was dropped). This surfaced as a corrupt for-in over a
   set when the loop variable collided with a member. Now rejected at the
   declaration with a clear message, mirroring the existing type-name-shadow
   rule (FPC/Delphi allow the shadow; Blaise does not).

Verified subset/superset truth tables and for-in over a set (no shadow) on
both backends, and that the shadow is now a compile error. Adds
TE2ESetOpsTests.TestRun_Set_SubsetSuperset and
TSemanticTests.TestVarDecl_ShadowsEnumMember_RaisesError. Rationale's
"Variable Names May Not Shadow Type Names" section extended to enum members.
This commit is contained in:
Graeme Geldenhuys 2026-06-16 17:00:09 +01:00
parent f4c612ef77
commit 07a1236896
7 changed files with 154 additions and 2 deletions

View file

@ -6031,7 +6031,7 @@ begin
{ Set arithmetic: union (+), difference (-), intersection (*), equality. }
if (BE.Left.ResolvedType <> nil) and
(BE.Left.ResolvedType.Kind = tySet) and
(BE.Op in [boAdd, boSub, boMul, boEQ, boNE]) then
(BE.Op in [boAdd, boSub, boMul, boEQ, boNE, boLE, boGE]) then
begin
if IsJumboSet(BE.Left.ResolvedType) then
begin
@ -6050,6 +6050,28 @@ begin
Self.Emit(#9'xorl $1, %eax');
Exit;
end;
{ Subset (<=) / superset (>=): _SetSubset(A, B) tests A subset of B.
For >= the operands are swapped (B subset of A). }
if BE.Op in [boLE, boGE] then
begin
Self.EmitExprToEax(BE.Left);
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(BE.Right);
if BE.Op = boLE then
begin
Self.Emit(#9'movq %rax, %rsi'); { B }
Self.Emit(#9'popq %rdi'); { A }
end
else
begin
Self.Emit(#9'movq %rax, %rdi'); { B -> A-arg }
Self.Emit(#9'popq %rsi'); { A -> B-arg }
end;
Self.Emit(Format(#9'movl $%d, %%edx',
[JumboSetNBytes(BE.Left.ResolvedType)]));
Self.Emit(#9'callq _SetSubset');
Exit;
end;
{ Union/intersection/difference: write the result into a frame scratch
slot and return its address. The _Set helper takes rdi=dest,
rsi=A, rdx=B, ecx=nbytes. %r12/%r13 are callee-saved across the two
@ -6096,6 +6118,25 @@ begin
Self.Emit(#9'setne %al');
Self.Emit(#9'movzbl %al, %eax');
end;
boLE, boGE:
begin
{ subset s<=t: (s and not t)=0 ; superset s>=t: (t and not s)=0.
%rax=s (left), %rcx=t (right). For <= mask = s and not t; for >=
mask = t and not s. Then test the mask is zero. }
if BE.Op = boLE then
begin
Self.Emit(#9'notq %rcx'); { ~t }
Self.Emit(#9'andq %rcx, %rax'); { s and ~t }
end
else
begin
Self.Emit(#9'notq %rax'); { ~s }
Self.Emit(#9'andq %rcx, %rax'); { t and ~s }
end;
Self.Emit(#9'testq %rax, %rax');
Self.Emit(#9'sete %al');
Self.Emit(#9'movzbl %al, %eax');
end;
end;
Exit;
end;

View file

@ -9019,6 +9019,9 @@ var
DataTemp: string;
SQT: string;
PMark: Integer;
CmpTemp: string;
SetTmpA: string;
SetTmpB: string;
SetNB: Integer; { jumbo set bitmap byte count }
SetRS: Integer; { jumbo set slot size (RawSize, 8-rounded) }
begin
@ -11991,6 +11994,12 @@ begin
[ArgTemp, L, R, SetNB]));
EmitLine(Format(' %s =w ceqw %s, 0', [T, ArgTemp]));
end;
boLE: { subset: A subset of B }
EmitLine(Format(' %s =w call $_SetSubset(l %s, l %s, w %d)',
[T, L, R, SetNB]));
boGE: { superset: B subset of A }
EmitLine(Format(' %s =w call $_SetSubset(l %s, l %s, w %d)',
[T, R, L, SetNB]));
else
raise ECodeGenError.Create(Format(
'Operator not supported for set types at line %d', [BinExpr.Line]));
@ -12019,6 +12028,24 @@ begin
EmitLine(Format(' %s =w cnel %s, %s', [T, L, R]))
else
EmitLine(Format(' %s =w cnew %s, %s', [T, L, R]));
boLE, { subset: s <= t iff (s and not t) = 0 }
boGE: { superset: s >= t iff (t and not s) = 0 }
begin
{ Pick which operand must be fully contained in the other. }
if BinExpr.Op = boLE then
begin ArgTemp := L; CmpTemp := R; end
else
begin ArgTemp := R; CmpTemp := L; end;
{ notOther := ~CmpTemp ; rem := ArgTemp and notOther ; result := rem = 0 }
SetTmpA := AllocTemp();
EmitLine(Format(' %s =%s xor %s, -1', [SetTmpA, SQT, CmpTemp]));
SetTmpB := AllocTemp();
EmitLine(Format(' %s =%s and %s, %s', [SetTmpB, SQT, ArgTemp, SetTmpA]));
if SQT = 'l' then
EmitLine(Format(' %s =w ceql %s, 0', [T, SetTmpB]))
else
EmitLine(Format(' %s =w ceqw %s, 0', [T, SetTmpB]));
end;
else
raise ECodeGenError.Create(Format(
'Operator not supported for set types at line %d', [BinExpr.Line]));

View file

@ -5526,6 +5526,7 @@ var
Typ: TTypeDesc;
VarName: string;
Sym: TSymbol;
EnumShadowSym: TSymbol;
begin
for I := 0 to ABlock.Decls.Count - 1 do
begin
@ -5587,6 +5588,19 @@ begin
Format('Duplicate identifier ''%s'' — a type with this name is ' +
'already visible', [VarName]),
Decl.Line, Decl.Col);
{ A variable may not share a name with a visible ENUM MEMBER (case-
insensitive). Shadowing it silently retargets the member in a set
literal `[A, c, D]` to the variable which is not a constant, so QBE
errors cryptically and native miscompiles the bitmask. Reject it, in
the same spirit as the type-name rule above. }
EnumShadowSym := FTable.Lookup(VarName);
if (EnumShadowSym <> nil) and (EnumShadowSym.Kind = skConstant) and
(EnumShadowSym.TypeDesc <> nil) and
(EnumShadowSym.TypeDesc.Kind = tyEnum) then
SemanticError(
Format('Duplicate identifier ''%s'' — an enum member with this name ' +
'is already visible', [VarName]),
Decl.Line, Decl.Col);
if Decl.IsThreadVar and not Decl.IsGlobal then
SemanticError('threadvar is only allowed at unit or program scope',
Decl.Line, Decl.Col);
@ -9986,7 +10000,8 @@ begin
Format('Incompatible set types in ''%s'': ''%s'' vs ''%s''',
[BinaryOpName(ABin.Op), LType.Name, RType.Name]),
ABin.Line, ABin.Col);
if ABin.Op in [boEQ, boNE] then
if ABin.Op in [boEQ, boNE, boLE, boGE] then
{ = <> equality; <= subset; >= superset — all yield Boolean. }
Result := FTable.TypeBoolean
else if ABin.Op in [boAdd, boSub, boMul] then
Result := LType

View file

@ -40,6 +40,7 @@ type
procedure TestRun_Set_EqualityWithLiteral;
procedure TestRun_Set_ForIn_PrintsMembers;
procedure TestRun_Set_RangeLiteral_Membership;
procedure TestRun_Set_SubsetSuperset;
{ 33..64-member sets (the QBE 'l' / 64-bit register boundary) }
procedure TestRun_Set64_InOperator_HighBit;
@ -169,6 +170,21 @@ const
end.
''';
{ Subset (<=) and superset (>=) operators. }
SrcSetSubset = '''
program Prg;
type TC = (Aa, Bb, Cc, Dd);
var s, t: set of TC;
begin
s := [Aa, Bb]; t := [Aa, Bb, Cc];
WriteLn(s <= t);
WriteLn(t <= s);
WriteLn(s >= t);
WriteLn(t >= s);
WriteLn(s <= s)
end.
''';
{ Set range literal (issue #105): [m1..m3] and a mixed [m0, m2..m4, m7]. }
SrcSetRange = '''
program Prg;
@ -324,6 +340,14 @@ begin
'n' + LE + 'y' + LE + 'y' + LE, 0);
end;
procedure TE2ESetOpsTests.TestRun_Set_SubsetSuperset;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ s<=t, t<=s, s>=t, t>=s, s<=s }
AssertRunsOnAll(SrcSetSubset,
'True' + LE + 'False' + LE + 'False' + LE + 'True' + LE + 'True' + LE, 0);
end;
procedure TE2ESetOpsTests.TestRun_Set64_InOperator_HighBit;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;

View file

@ -36,6 +36,7 @@ type
procedure TestVarDecl_DuplicatesInterfaceType_RaisesError;
procedure TestVarDecl_ShadowsBuiltinType_RaisesError;
procedure TestVarDecl_ShadowsOuterScopeType_RaisesError;
procedure TestVarDecl_ShadowsEnumMember_RaisesError;
{ Const then var with same name in same block is a duplicate }
procedure TestVarDecl_DuplicatesConst_RaisesError;
{ Const redeclared with same name in same block is a duplicate }
@ -234,6 +235,15 @@ begin
'begin Q(); end.');
end;
procedure TSemanticTests.TestVarDecl_ShadowsEnumMember_RaisesError;
begin
{ A var may not shadow a visible enum member shadowing silently retargets
the member in a set literal to the variable, miscompiling the bitmask.
Blaise rejects it, in the same spirit as the type-name-shadow rule. }
AnalyseExpectError(
'program P; type TC = (A, B, C); var c: TC; begin end.');
end;
procedure TSemanticTests.TestVarDecl_DuplicatesConst_RaisesError;
begin
AnalyseExpectError(

View file

@ -4412,6 +4412,24 @@ when the variable clashes with a type declared in the *same* scope, and
silently permits a variable to shadow a built-in or outer-scope type
(`var Integer: Int64` compiles in FPC).
The same rule applies to *enum members*: a variable may not share its name with
a visible enum constant.
[source,pascal]
----
type TC = (A, B, C, D);
var c: TC; // ERROR: 'c' and the enum member 'C' are the same identifier
----
Without this rule the variable shadows the member, so a set literal that names
the member — `s := [A, C, D]` — silently resolves `C` to the variable (not the
constant). That is not a compile-time constant, so the QBE backend rejects it
with a cryptic message while the native backend produced a *wrong bitmap with
no error at all* (the member's bit was simply dropped). Rejecting the shadow
at the declaration, with `Duplicate identifier 'X' — an enum member with this
name is already visible`, removes both failure modes (FPC/Delphi allow the
shadow; Blaise does not, consistent with the type-name rule above).
=== Rationale
A variable that bears the same name as a type is almost always a mistake, and

View file

@ -42,6 +42,7 @@ procedure _SetUnion(Dest, A, B: Pointer; NBytes: Integer); { Dest := A or B }
procedure _SetInter(Dest, A, B: Pointer; NBytes: Integer); { Dest := A and B }
procedure _SetDiff(Dest, A, B: Pointer; NBytes: Integer); { Dest := A and not B }
function _SetEqual(A, B: Pointer; NBytes: Integer): Integer; { 1 if equal }
function _SetSubset(A, B: Pointer; NBytes: Integer): Integer; { 1 if A subset of B }
procedure _SetCopy(Dest, Src: Pointer; NBytes: Integer); { byte copy }
implementation
@ -149,6 +150,22 @@ begin
Result := 1;
end;
{ 1 if A is a subset of B (every bit set in A is also set in B), else 0. }
function _SetSubset(A, B: Pointer; NBytes: Integer): Integer;
var
I: Integer;
begin
I := 0;
while I < NBytes do
begin
{ A byte of A has a bit absent from B iff (A[i] and not B[i]) <> 0. }
if (GetByte(A, I) and not GetByte(B, I)) <> 0 then
Exit(0);
Inc(I);
end;
Result := 1;
end;
procedure _SetCopy(Dest, Src: Pointer; NBytes: Integer);
var
I: Integer;