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

fix: element access through array-typed fields — r.A[i], c.N.A[i], SetLength(r.A)

Browse source 
Array-typed FIELDS were second-class citizens for element access; this
lands the full variation family on both backends:

- Semantic: r.A[i] := v dropped the subscript from the LHS type — the
  parser stores it in TFieldAssignment.PropIndexExpr (the indexed-
  property slot) and semantic ignored it for real fields, demanding the
  whole array type on the RHS.  A subscript on a real dyn/static-array
  field is now an ELEMENT write (new semantic-set IsElemWrite flag);
  both backends emit the element store with the standard ARC and
  record-copy rules.

- Parser: c.N.A[i] := v failed with "Expected 'end' but got '['" —
  the chained L-value walker now accepts a terminating Field[idx] :=,
  and the subscript-chain path accepts arr[i].A[j] := v (subscript
  directly over another subscript stays a clear parse error).

- Bare implicit-Self: A[i] := v inside a method raised "Undeclared
  variable 'A'" — TStaticSubscriptAssign now resolves array-typed
  fields of Self (IsImplicitSelf + ImplicitFieldInfo).

- SetLength(r.A, n): QBE refused ("first argument must be a
  variable"); native silently emitted NO code for field receivers and
  mis-stored through var-param receivers.  QBE routes through
  EmitLValueAddr; native gains EmitLValueSlotAddr covering field,
  var-param and implicit-Self receivers for dyn-array and string
  SetLength.

- Read side: c.A[i] through a class variable computed the element base
  as if c were an inline record (missing object-pointer load) and
  segfaulted; implicit-Self bases had the same gap; native missed
  chained reads (c.N.A[i]) entirely.  All base shapes are handled in
  the IsArrayAccess read paths of both backends now.

bif-coverage.status regenerated for the new semantic-set AST fields
(safe).  Tests: 4 IR tests (cp.test.dynarray) + 6 e2e tests on both
backends (cp.test.e2e.records) covering record/class/implicit-Self
receivers, nested chains, static-array fields and string-element ARC.
Suite: 2922 OK on working and fixpoint binaries; FIXPOINT_OK (single
round); NATIVE_FIXPOINT_OK.
This commit is contained in:
Graeme Geldenhuys 2026-06-11 09:19:35 +01:00
parent 7b4db4d11d
commit 5f0fbb7643
9 changed files with 832 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

258
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -403,6 +403,7 @@ type
procedure EmitNarrowToType(AType: TTypeDesc);
{ Inc(x)/Dec(x) with support for simple variables, implicit-Self fields,
var params, and field-access expressions. }
procedure EmitLValueSlotAddr(AExpr: TASTExpr);
procedure EmitIncDec(ACall: TProcCall);
procedure EmitIncDecAddrOp(IsInc, IsWide, HasStep: Boolean);
{ Evaluate a boolean condition and branch: if true jump ATrueLabel, else
@ -3106,6 +3107,74 @@ end;
- var-param TIdentExpr (dereference the pointer)
- TFieldAccessExpr (Rec.Field, Obj.Field)
- TDerefExpr (P^) }
{ Compute the ADDRESS of an L-value slot into %rdx. Supports plain
identifiers (locals, globals, var-params, implicit-Self fields) and
field-access targets: R.F (inline record), C.F (class variable — slot
holds the object pointer), implicit-Self record/class bases, var-param
record bases, and chained Base.F (Base evaluated to an address). }
procedure TX86_64Backend.EmitLValueSlotAddr(AExpr: TASTExpr);
var
IE: TIdentExpr;
FAE: TFieldAccessExpr;
FI: TFieldInfo;
begin
if AExpr is TIdentExpr then
begin
IE := TIdentExpr(AExpr);
if IE.IsImplicitSelf and (IE.ImplicitFieldInfo <> nil) then
begin
FI := TFieldInfo(IE.ImplicitFieldInfo);
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand('Self')]));
if FI.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rdx', [FI.Offset]));
end
else if IE.ParamMode <> pmNone then
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(IE.Name)]))
else if Self.IsLocal(IE.Name) then
Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(IE.Name)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [IE.Name]));
Exit;
end;
if AExpr is TFieldAccessExpr then
begin
FAE := TFieldAccessExpr(AExpr);
if FAE.FieldInfo = nil then
raise ENativeCodeGenError.Create(
'native backend: L-value field access has no resolved field info');
if FAE.Base <> nil then
begin
Self.EmitExprToEax(FAE.Base);
Self.Emit(#9'movq %rax, %rdx');
end
else if FAE.IsImplicitSelf then
begin
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand('Self')]));
if (FAE.ImplicitBaseInfo <> nil) and (FAE.ImplicitBaseInfo.Offset > 0) then
Self.Emit(Format(#9'addq $%d, %%rdx', [FAE.ImplicitBaseInfo.Offset]));
if FAE.IsClassAccess then
Self.Emit(#9'movq (%rdx), %rdx');
end
else if FAE.IsClassAccess or FAE.IsVarParam then
begin
{ Class variable / var-param: the slot holds a POINTER — load it. }
if Self.IsLocal(FAE.RecordName) then
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(FAE.RecordName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rdx', [FAE.RecordName]));
end
else if Self.IsLocal(FAE.RecordName) then
Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(FAE.RecordName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [FAE.RecordName]));
if FAE.FieldInfo.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rdx', [FAE.FieldInfo.Offset]));
Exit;
end;
raise ENativeCodeGenError.Create(
'native backend: unsupported L-value form');
end;
procedure TX86_64Backend.EmitIncDec(ACall: TProcCall);
var
Arg0: TASTExpr;
@ -5173,13 +5242,32 @@ begin
field, then index into the array (static, dynamic, or open). }
if (AExpr is TFieldAccessExpr) and
TFieldAccessExpr(AExpr).IsArrayAccess and
(TFieldAccessExpr(AExpr).FieldInfo <> nil) and
(TFieldAccessExpr(AExpr).Base = nil) then
(TFieldAccessExpr(AExpr).FieldInfo <> nil) then
begin
FAE := TFieldAccessExpr(AExpr);
if FAE.IsVarParam then
if FAE.Base <> nil then
begin
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FAE.RecordName)]));
{ Chained receiver (c.N.Arr[I]): the base expression evaluates to the
record/object address. }
Self.EmitExprToEax(FAE.Base);
Self.Emit(#9'movq %rax, %rcx');
end
else if FAE.IsImplicitSelf then
begin
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if (FAE.ImplicitBaseInfo <> nil) and (FAE.ImplicitBaseInfo.Offset > 0) then
Self.Emit(Format(#9'addq $%d, %%rcx', [FAE.ImplicitBaseInfo.Offset]));
if FAE.IsClassAccess then
Self.Emit(#9'movq (%rcx), %rcx');
end
else if FAE.IsClassAccess or FAE.IsVarParam then
begin
{ Class variable / var-param: the slot holds a POINTER to the object
or record — load it. }
if Self.IsLocal(FAE.RecordName) then
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FAE.RecordName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FAE.RecordName]));
end
else if Self.IsLocal(FAE.RecordName) then
Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(FAE.RecordName)]))
@ -8283,7 +8371,9 @@ begin
(TASTExpr(PC.Args.Items[0]).ResolvedType <> nil) and
(TASTExpr(PC.Args.Items[0]).ResolvedType.Kind = tyDynArray) then
begin
if TASTExpr(PC.Args.Items[0]) is TIdentExpr then
if (TASTExpr(PC.Args.Items[0]) is TIdentExpr) and
not TIdentExpr(TASTExpr(PC.Args.Items[0])).IsImplicitSelf and
(TIdentExpr(TASTExpr(PC.Args.Items[0])).ParamMode = pmNone) then
begin
FDynArgName := TIdentExpr(TASTExpr(PC.Args.Items[0])).Name;
FDynElemSz :=
@ -8304,6 +8394,26 @@ begin
Self.Emit(Format(#9'movq %%rax, %s', [Self.VarOperand(FDynArgName)]))
else
Self.Emit(Format(#9'movq %%rax, %s(%%rip)', [FDynArgName]));
end
else
begin
{ Field receiver (R.A / C.A / chained): compute the slot address,
call through it, store the new data pointer back. }
FDynElemSz :=
TDynArrayTypeDesc(TASTExpr(PC.Args.Items[0]).ResolvedType).ElementType.RawSize();
Self.EmitLValueSlotAddr(TASTExpr(PC.Args.Items[0]));
Self.Emit(#9'pushq %rdx');
Self.EmitExprToEax(TASTExpr(PC.Args.Items[1]));
Self.Emit(#9'popq %rdx');
Self.Emit(#9'pushq %rdx');
Self.Emit(#9'subq $8, %rsp'); { keep calls 16-byte aligned }
Self.Emit(#9'movl %eax, %esi');
Self.Emit(#9'movq (%rdx), %rdi');
Self.Emit(Format(#9'movl $%d, %%edx', [FDynElemSz]));
Self.Emit(#9'callq _DynArraySetLength');
Self.Emit(#9'addq $8, %rsp');
Self.Emit(#9'popq %rdx');
Self.Emit(#9'movq %rax, (%rdx)');
end;
Exit;
end;
@ -8318,7 +8428,9 @@ begin
Self.Emit(#9'movl %eax, %esi');
Self.Emit(#9'popq %rdi');
Self.Emit(#9'callq _StringSetLength');
if TASTExpr(PC.Args.Items[0]) is TIdentExpr then
if (TASTExpr(PC.Args.Items[0]) is TIdentExpr) and
not TIdentExpr(TASTExpr(PC.Args.Items[0])).IsImplicitSelf and
(TIdentExpr(TASTExpr(PC.Args.Items[0])).ParamMode = pmNone) then
begin
Self.Emit(#9'pushq %rax');
Self.Emit(#9'movq %rax, %rdi');
@ -8337,6 +8449,21 @@ begin
else
Self.Emit(Format(#9'movq %%rax, %s(%%rip)',
[TIdentExpr(TASTExpr(PC.Args.Items[0])).Name]));
end
else
begin
{ Field receiver: new string is in %rax — retain it, release the old
field value, store through the slot address. }
Self.Emit(#9'pushq %rax');
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'callq _StringAddRef');
Self.EmitLValueSlotAddr(TASTExpr(PC.Args.Items[0]));
Self.Emit(#9'pushq %rdx');
Self.Emit(#9'movq (%rdx), %rdi');
Self.Emit(#9'callq _StringRelease');
Self.Emit(#9'popq %rdx');
Self.Emit(#9'popq %rax');
Self.Emit(#9'movq %rax, (%rdx)');
end;
Exit;
end;
@ -8729,6 +8856,104 @@ begin
if FA.FieldInfo = nil then
raise ENativeCodeGenError.Create(
'native backend: field assignment has no resolved field info');
{ Element write into an array-typed field: Receiver.Field[Idx] := V.
Evaluate the value, the scaled index, then the field slot address;
for a dynamic array deref the slot to reach the data pointer; store
by ELEMENT type with the same ARC rules as plain subscript writes. }
if FA.IsElemWrite then
begin
if FA.FieldInfo.TypeDesc.Kind = tyDynArray then
DAElemType := TDynArrayTypeDesc(FA.FieldInfo.TypeDesc).ElementType
else
DAElemType := TStaticArrayTypeDesc(FA.FieldInfo.TypeDesc).ElementType;
Self.EmitExprToEax(FA.Expr);
Self.Emit(#9'pushq %rax'); { value (or record src addr) }
Self.EmitExprToEax(FA.PropIndexExpr);
if (FA.FieldInfo.TypeDesc.Kind = tyStaticArray) and
(TStaticArrayTypeDesc(FA.FieldInfo.TypeDesc).LowBound <> 0) then
Self.Emit(Format(#9'subq $%d, %%rax',
[TStaticArrayTypeDesc(FA.FieldInfo.TypeDesc).LowBound]));
Self.Emit(Format(#9'imulq $%d, %%rax', [DAElemType.RawSize()]));
Self.Emit(#9'pushq %rax'); { scaled element offset }
{ Field slot address → %rdx, per receiver shape. }
if FA.ObjExpr <> nil then
begin
Self.EmitExprToEax(FA.ObjExpr);
Self.Emit(#9'movq %rax, %rdx');
end
else if FSretFunc and (FA.RecordName = 'Result') then
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand('Result')]))
else if FA.IsImplicitSelf then
begin
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand('Self')]));
if (FA.ImplicitBaseInfo <> nil) and (FA.ImplicitBaseInfo.Offset > 0) then
Self.Emit(Format(#9'addq $%d, %%rdx', [FA.ImplicitBaseInfo.Offset]));
if FA.IsClassAccess then
Self.Emit(#9'movq (%rdx), %rdx');
end
else if FA.IsClassAccess or FA.IsVarParam then
begin
if Self.IsLocal(FA.RecordName) then
Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(FA.RecordName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rdx', [FA.RecordName]));
end
else if Self.IsLocal(FA.RecordName) then
Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(FA.RecordName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [FA.RecordName]));
if FA.FieldInfo.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rdx', [FA.FieldInfo.Offset]));
if FA.FieldInfo.TypeDesc.Kind = tyDynArray then
Self.Emit(#9'movq (%rdx), %rdx'); { data pointer }
Self.Emit(#9'popq %rax'); { scaled offset }
Self.Emit(#9'addq %rax, %rdx');
Self.Emit(#9'movq %rdx, %rcx'); { element address }
if DAElemType.Kind = tyRecord then
begin
{ Record element: ARC-aware copy (retain src fields, release dest
fields, memcpy). Source record address is on the stack. }
Self.Emit(#9'pushq %rbx');
Self.Emit(#9'pushq %r15');
Self.Emit(#9'subq $8, %rsp');
Self.Emit(#9'movq %rcx, %r15'); { dest element addr }
Self.Emit(#9'movq 24(%rsp), %rbx'); { src record addr }
Self.EmitRecordFieldRetains(TRecordTypeDesc(DAElemType), '%rbx');
Self.EmitRecordFieldReleases(TRecordTypeDesc(DAElemType), '%r15');
Self.Emit(#9'movq %r15, %rdi');
Self.Emit(#9'movq %rbx, %rsi');
Self.Emit(Format(#9'movq $%d, %%rdx', [DAElemType.RawSize()]));
Self.Emit(#9'callq memcpy');
Self.Emit(#9'addq $8, %rsp');
Self.Emit(#9'popq %r15');
Self.Emit(#9'popq %rbx');
Self.Emit(#9'addq $8, %rsp'); { drop saved src addr }
Exit;
end;
if DAElemType.Kind = tyString then
begin
Self.Emit(#9'pushq %rcx');
Self.Emit(#9'movq 8(%rsp), %rdi');
Self.Emit(#9'callq _StringAddRef');
Self.Emit(#9'movq (%rsp), %rcx');
Self.Emit(#9'movq (%rcx), %rdi');
Self.Emit(#9'callq _StringRelease');
Self.Emit(#9'popq %rcx');
end
else if DAElemType.Kind = tyClass then
begin
Self.Emit(#9'pushq %rcx');
Self.Emit(#9'movq 8(%rsp), %rdi');
Self.Emit(#9'callq _ClassAddRef');
Self.Emit(#9'movq (%rsp), %rcx');
Self.Emit(#9'movq (%rcx), %rdi');
Self.Emit(#9'callq _ClassRelease');
Self.Emit(#9'popq %rcx');
end;
Self.Emit(#9'popq %rax');
Self.EmitStoreVar('(%rcx)', DAElemType);
Exit;
end;
{ Interface-typed field: store a two-slot fat pointer (obj + itab), not a
single value. Compute the destination record/object base into %rcx for
each receiver shape, then hand off to EmitInterfaceToFieldSlotsAt (which
@ -9263,7 +9488,16 @@ begin
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(SSA.IndexExpr);
Self.Emit(Format(#9'imulq $%d, %%rax', [DAElemType.RawSize()]));
if Self.IsLocal(SSA.ArrayName) then
if SSA.IsImplicitSelf then
begin
{ ArrayName is a dyn-array field of Self: Self + offset holds the
data pointer. }
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if SSA.ImplicitFieldInfo.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rcx', [SSA.ImplicitFieldInfo.Offset]));
Self.Emit(#9'movq (%rcx), %rcx');
end
else if Self.IsLocal(SSA.ArrayName) then
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [SSA.ArrayName]));
@ -9329,7 +9563,15 @@ begin
Self.Emit(Format(#9'subq $%d, %%rax',
[TStaticArrayTypeDesc(SSA.ResolvedArrayType).LowBound]));
Self.Emit(Format(#9'imulq $%d, %%rax', [DAElemType.RawSize()]));
if Self.IsLocal(SSA.ArrayName) then
if SSA.IsImplicitSelf then
begin
{ ArrayName is a static-array field of Self: the inline storage
starts at Self + field offset. }
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('Self')]));
if SSA.ImplicitFieldInfo.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rcx', [SSA.ImplicitFieldInfo.Offset]));
end
else if Self.IsLocal(SSA.ArrayName) then
Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)]))
else
Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [SSA.ArrayName]));

192
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -247,6 +247,8 @@ type
procedure EmitCompoundStmt(AStmt: TCompoundStmt);
procedure EmitAssignment(AAssign: TAssignment);
procedure EmitFieldAssignment(AAssign: TFieldAssignment);
procedure EmitFieldElemStore(AAssign: TFieldAssignment;
const AFieldPtr: string);
procedure EmitMethodCall(ACall: TMethodCallStmt);
{ After a call, release any value-argument temporaries that carried a
+1-owned reference (function/property/method returns passed directly).
@ -5197,6 +5199,97 @@ begin
end;
end;
{ Element write into an array-typed field: Receiver.Field[Index] := Value.
AFieldPtr addresses the FIELD slot (computed by EmitFieldAssignment for
every receiver shape). For a dynamic-array field the data pointer is
loaded from the slot; for a static-array field the slot IS the inline
storage. The value is stored by ELEMENT type with the same ARC and
record-copy rules as plain array subscript writes. }
procedure TCodeGenQBE.EmitFieldElemStore(AAssign: TFieldAssignment;
const AFieldPtr: string);
var
ArrT: TTypeDesc;
ElemT: TTypeDesc;
LowBnd: Integer;
ElemSize: Integer;
BaseT: string;
IdxW: string;
IdxL: string;
Adj: string;
Offset: string;
ElemPtr: string;
ValTemp: string;
OldTemp: string;
begin
ArrT := AAssign.FieldInfo.TypeDesc;
if ArrT.Kind = tyDynArray then
begin
ElemT := TDynArrayTypeDesc(ArrT).ElementType;
LowBnd := 0;
BaseT := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [BaseT, AFieldPtr])); { data pointer }
end
else
begin
ElemT := TStaticArrayTypeDesc(ArrT).ElementType;
LowBnd := TStaticArrayTypeDesc(ArrT).LowBound;
BaseT := AFieldPtr; { inline storage starts at the field slot }
end;
ElemSize := ElemT.RawSize();
IdxW := EmitExpr(AAssign.PropIndexExpr);
IdxL := AllocTemp();
EmitLine(Format(' %s =l extsw %s', [IdxL, IdxW]));
if LowBnd <> 0 then
begin
Adj := AllocTemp();
EmitLine(Format(' %s =l sub %s, %d', [Adj, IdxL, LowBnd]));
IdxL := Adj;
end;
Offset := AllocTemp();
EmitLine(Format(' %s =l mul %s, %d', [Offset, IdxL, ElemSize]));
ElemPtr := AllocTemp();
EmitLine(Format(' %s =l add %s, %s', [ElemPtr, BaseT, Offset]));
if ElemT.Kind = tyRecord then
begin
ValTemp := EmitExpr(AAssign.Expr);
EmitRecordCopy(TRecordTypeDesc(ElemT), ElemPtr, ValTemp);
Exit;
end;
if ElemT.Kind in [tyByte, tyBoolean] then
ValTemp := EmitByteRhs(AAssign.Expr)
else
ValTemp := EmitExpr(AAssign.Expr);
{ Extend w-typed values into 8-byte integer elements. }
if (ElemT.Kind in [tyInt64, tyUInt64]) and
(AAssign.Expr.ResolvedType <> nil) and
not (AAssign.Expr.ResolvedType.Kind in [tyInt64, tyUInt64]) then
begin
Adj := AllocTemp();
if ElemT.Kind = tyUInt64 then
EmitLine(Format(' %s =l extuw %s', [Adj, ValTemp]))
else
EmitLine(Format(' %s =l extsw %s', [Adj, ValTemp]));
ValTemp := Adj;
end;
{ ARC for managed element types: retain new, release old, then store. }
if ElemT.IsString() then
begin
OldTemp := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [OldTemp, ElemPtr]));
EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp]));
EmitLine(Format(' call $_StringRelease(l %s)', [OldTemp]));
end
else if ElemT.Kind = tyClass then
begin
OldTemp := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [OldTemp, ElemPtr]));
EmitLine(Format(' call $_ClassAddRef(l %s)', [ValTemp]));
EmitLine(Format(' call $_ClassRelease(l %s)', [OldTemp]));
end;
EmitLine(Format(' %s %s, %s', [StoreInstrFor(ElemT), ValTemp, ElemPtr]));
end;
procedure TCodeGenQBE.EmitFieldAssignment(AAssign: TFieldAssignment);
var
Ptr, PtrTemp, ValTemp, OldTemp, QType, StoreInstr, ExtTemp: string;
@ -5260,8 +5353,10 @@ begin
{ Interface-typed field: the RHS must be stored as a two-slot fat pointer
(obj + itab), not a single value. EmitInterfaceToFieldSlots evaluates the
RHS itself, so the generic single-value EmitExpr below must be skipped for
this case (re-evaluating would double any side effects). }
if AAssign.FieldInfo.TypeDesc.Kind <> tyInterface then
this case (re-evaluating would double any side effects). Element writes
also evaluate the RHS themselves (after the index). }
if (AAssign.FieldInfo.TypeDesc.Kind <> tyInterface) and
not AAssign.IsElemWrite then
ValTemp := EmitExpr(AAssign.Expr);
if AAssign.ObjExpr <> nil then
@ -5339,6 +5434,14 @@ begin
else
Ptr := FieldPtr(AAssign.RecordName, AAssign.FieldInfo.Offset, AAssign.IsGlobal);
{ Element write into an array-typed field: Ptr addresses the FIELD;
redirect to the selected element and store by element type. }
if AAssign.IsElemWrite then
begin
EmitFieldElemStore(AAssign, Ptr);
Exit;
end;
{ Interface-typed field: store the fat pointer (obj at Ptr, itab at Ptr+8)
with ARC on the obj slot. EmitInterfaceToFieldSlots handles both an
interface-typed RHS (copy obj+itab) and a class-typed RHS (obj + static
@ -7746,14 +7849,10 @@ var
Extra: string;
I: Integer;
begin
{ Address of the string slot (works for plain idents, var params,
implicit-Self fields). Field-access targets (R.F or P^.F) are not
supported here — semantic enforces the L-value forms we accept. }
if TASTExpr(ACall.Args.Items[0]) is TIdentExpr then
Addr := EmitVarArgAddr(TIdentExpr(TASTExpr(ACall.Args.Items[0])))
else
raise ECodeGenError.Create(
'String mutator on non-ident receiver not yet supported');
{ Address of the string slot. EmitLValueAddr covers plain idents, var
params, implicit-Self fields, field-access targets (R.F, C.F, P^.F)
and raises for unsupported L-value shapes. }
Addr := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
OldTemp := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [OldTemp, Addr]));
@ -7781,10 +7880,9 @@ var
ElemSz: Integer;
DAT: TDynArrayTypeDesc;
begin
if not (TASTExpr(ACall.Args.Items[0]) is TIdentExpr) then
raise ECodeGenError.Create(
'SetLength on dynamic array: first argument must be a variable');
Addr := EmitVarArgAddr(TIdentExpr(TASTExpr(ACall.Args.Items[0])));
{ EmitLValueAddr covers plain idents, var params, implicit-Self fields and
field-access targets (R.F, C.F, P^.F); it raises for unsupported shapes. }
Addr := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
OldPtr := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [OldPtr, Addr]));
NTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
@ -10251,14 +10349,32 @@ begin
end
else if FldAccess.IsArrayAccess then
begin
{ Array field subscript: Rec.Arr[I] — load array base, compute element addr. }
{ Array field subscript: Rec.Arr[I] — load array base, compute element
addr. The receiver base address depends on the leaf shape: class
variables and var-params hold a POINTER in their slot (load it);
implicit-Self fields start from the Self pointer; inline records use
the slot address directly. }
L := AllocTemp();
if FldAccess.IsVarParam then
if FldAccess.IsImplicitSelf then
begin
T := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [T, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)]));
L := T;
EmitLine(Format(' %s =l loadl %%_var_Self', [L]));
if (FldAccess.ImplicitBaseInfo <> nil) and
(FldAccess.ImplicitBaseInfo.Offset > 0) then
begin
T := AllocTemp();
EmitLine(Format(' %s =l add %s, %d',
[T, L, FldAccess.ImplicitBaseInfo.Offset]));
L := T;
end;
if FldAccess.IsClassAccess then
begin
T := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [T, L]));
L := T;
end;
end
else if FldAccess.IsClassAccess or FldAccess.IsVarParam then
EmitLine(Format(' %s =l loadl %s', [L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)]))
else
EmitLine(Format(' %s =l copy %s', [L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)]));
if FldAccess.FieldInfo.Offset > 0 then
@ -12653,7 +12769,23 @@ begin
ElemSize := ElemType.RawSize();
PCharBase := AllocTemp();
{ load the data pointer from the variable slot }
if AStmt.IsGlobal then
if AStmt.IsImplicitSelf then
begin
{ ArrayName is a dyn-array field of Self: Self + offset holds the
data pointer. }
EmitLine(Format(' %s =l loadl %%_var_Self', [PCharBase]));
if AStmt.ImplicitFieldInfo.Offset > 0 then
begin
ElemPtr := AllocTemp();
EmitLine(Format(' %s =l add %s, %d',
[ElemPtr, PCharBase, AStmt.ImplicitFieldInfo.Offset]));
PCharBase := ElemPtr;
end;
ElemPtr := AllocTemp();
EmitLine(Format(' %s =l loadl %s', [ElemPtr, PCharBase]));
PCharBase := ElemPtr;
end
else if AStmt.IsGlobal then
EmitLine(Format(' %s =l loadl $%s', [PCharBase, AStmt.ArrayName]))
else if IsPromoted(AStmt.ArrayName) then
EmitLine(Format(' %s =l copy %%_var_%s', [PCharBase, AStmt.ArrayName]))
@ -12739,8 +12871,24 @@ begin
end
else
EmitLine(Format(' %s =l mul %s, %d', [Offset, IdxL, ElemSize]));
EmitLine(Format(' %s =l add %s, %s',
[ElemPtr, VarRef(AStmt.ArrayName, AStmt.IsGlobal), Offset]));
if AStmt.IsImplicitSelf then
begin
{ ArrayName is a static-array field of Self: the inline storage starts
at Self + field offset. }
PCharBase := AllocTemp();
EmitLine(Format(' %s =l loadl %%_var_Self', [PCharBase]));
if AStmt.ImplicitFieldInfo.Offset > 0 then
begin
Adj := AllocTemp();
EmitLine(Format(' %s =l add %s, %d',
[Adj, PCharBase, AStmt.ImplicitFieldInfo.Offset]));
PCharBase := Adj;
end;
EmitLine(Format(' %s =l add %s, %s', [ElemPtr, PCharBase, Offset]));
end
else
EmitLine(Format(' %s =l add %s, %s',
[ElemPtr, VarRef(AStmt.ArrayName, AStmt.IsGlobal), Offset]));
if ElemType.Kind = tyRecord then
begin
ElemVal := EmitExpr(AStmt.ValueExpr);

7
compiler/src/main/pascal/uAST.pas
View file

@ -357,9 +357,12 @@ type
[Unretained] ImplicitBaseInfo: TFieldInfo; { non-owned — the field of Self that holds the record/class }
IsGlobal: Boolean; { set by uSemantic — RecordName is a program-level global }
IsVarParam: Boolean; { set by uSemantic — RecordName is a var parameter (record by-ref) }
PropIndexExpr: TASTExpr; { owned — non-nil = indexed property write via setter }
PropIndexExpr: TASTExpr; { owned — non-nil = indexed property write via setter,
OR (IsElemWrite) the element index into an array-typed field }
[Unretained] PropWriteInfo: TPropertyInfo; { non-owned — set by semantic when PropIndexExpr is set }
PropOwnerType: string; { owner class name for setter call; valid when PropIndexExpr set }
IsElemWrite: Boolean; { set by uSemantic — FieldName is an array-typed field and
PropIndexExpr selects the element to store into }
destructor Destroy; override;
end;
@ -371,6 +374,8 @@ type
ValueExpr: TASTExpr; { owned }
IsGlobal: Boolean; { set by uSemantic }
[Unretained] ResolvedArrayType: TTypeDesc; { set by uSemantic; not owned }
IsImplicitSelf: Boolean; { set by uSemantic — ArrayName is an array-typed field of Self }
[Unretained] ImplicitFieldInfo: TFieldInfo; { non-owned — the Self field; set with IsImplicitSelf }
destructor Destroy; override;
end;

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

@ -2050,9 +2050,32 @@ begin
SubNode.IndexExpr := ParseExpr();
Expect(tkRBracket);
if Check(tkAssign) then
begin
if SubNode.StrExpr is TFieldAccessExpr then
begin
{ …Field[idx] := value — element write into an array-typed
field (or indexed property write). Rebuild as a
TFieldAssignment: receiver = the field's base, index =
the subscript. }
Advance(); { consume ':=' }
FldNode := TFieldAccessExpr(SubNode.StrExpr);
FldAssign := TFieldAssignment.Create();
FldAssign.Line := Line;
FldAssign.Col := Col;
FldAssign.FieldName := FldNode.FieldName;
FldAssign.ObjExpr := FldNode.Base;
FldNode.Base := nil;
FldAssign.PropIndexExpr := SubNode.IndexExpr;
SubNode.IndexExpr := nil;
ChainBase := nil;
SubNode.Free(); { frees the now-detached field node too }
FldAssign.Expr := ParseExpr();
Exit(FldAssign);
end;
raise EParseError.Create(Format(
'Subscript assignment through a chained base is not yet supported at line %d col %d in %s',
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
end;
Continue;
end;
if not Check(tkDot) then
@ -2264,6 +2287,26 @@ begin
FldNode.FieldName:= SecondIdent;
MCall.ObjExpr := FldNode;
end
else if Check(tkLBracket) then
begin
{ Chained indexed L-value: A.B.C[idx] := value — element write
into an array-typed field (or indexed property write) reached
via a chain. Semantic disambiguates field vs property. }
Advance(); { consume '[' }
FldAssign := TFieldAssignment.Create();
FldAssign.Line := Line;
FldAssign.Col := Col;
FldAssign.FieldName := SecondIdent;
FldAssign.ObjExpr := MCall.ObjExpr;
MCall.ObjExpr := nil; { transfer ownership }
MCall.Free();
MCall := nil;
FldAssign.PropIndexExpr := ParseExpr();
Expect(tkRBracket);
Expect(tkAssign);
FldAssign.Expr := ParseExpr();
Exit(FldAssign);
end
else
begin
MCall.Name := SecondIdent;

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

@ -165,6 +165,8 @@ type
procedure AnalyseStmt(AStmt: TASTStmt);
procedure AnalyseAssignment(AAssign: TAssignment);
procedure AnalyseFieldAssignment(AAssign: TFieldAssignment);
function TryAnalyseFieldElemWrite(AAssign: TFieldAssignment;
AFldInfo: TFieldInfo): Boolean;
procedure AnalyseProcCall(ACall: TProcCall);
{ Phase A/B overload resolution. Walks FProcIndex collecting all
decls whose name matches AName (case-insensitive); filters by
@ -5720,6 +5722,44 @@ begin
ACall.ResolvedMethod := MDecl;
end;
{ Element write into an array-typed FIELD: Receiver.Field[Index] := Value.
The parser stores the subscript in PropIndexExpr (the same slot used for
indexed property writes); when Field resolves to a real array field the
subscript is an ELEMENT index — the RHS must match the element type, not
the array type. Returns False when there is no subscript to interpret;
errors out when a subscript is applied to a non-array field. }
function TSemanticAnalyser.TryAnalyseFieldElemWrite(AAssign: TFieldAssignment;
AFldInfo: TFieldInfo): Boolean;
var
ElemT: TTypeDesc;
IdxType: TTypeDesc;
ExprType: TTypeDesc;
begin
Result := False;
if AAssign.PropIndexExpr = nil then
Exit;
if AFldInfo.TypeDesc.Kind = tyDynArray then
ElemT := TDynArrayTypeDesc(AFldInfo.TypeDesc).ElementType
else if AFldInfo.TypeDesc.Kind = tyStaticArray then
ElemT := TStaticArrayTypeDesc(AFldInfo.TypeDesc).ElementType
else
begin
SemanticError(
Format('Field ''%s'' is not an array — cannot assign to a subscript',
[AAssign.FieldName]),
AAssign.Line, AAssign.Col);
Exit;
end;
IdxType := AnalyseExpr(AAssign.PropIndexExpr);
if not IdxType.IsNumeric() then
SemanticError('Array index must be numeric', AAssign.Line, AAssign.Col);
ExprType := AnalyseExpr(AAssign.Expr);
CheckTypesMatch(ElemT, ExprType,
Format('''%s'' element', [AAssign.FieldName]), AAssign.Line, AAssign.Col);
AAssign.IsElemWrite := True;
Result := True;
end;
procedure TSemanticAnalyser.AnalyseFieldAssignment(AAssign: TFieldAssignment);
var
RecSym: TSymbol;
@ -5757,6 +5797,8 @@ begin
end;
AAssign.IsClassAccess := ObjType.Kind = tyClass;
AAssign.FieldInfo := FldInfo;
if TryAnalyseFieldElemWrite(AAssign, FldInfo) then
Exit;
{ Set-literal RHS into a tySet field — analyse with set context. }
if (FldInfo.TypeDesc.Kind = tySet) and (AAssign.Expr is TArrayLiteralExpr) then
begin
@ -5819,6 +5861,8 @@ begin
AAssign.Line, AAssign.Col);
end;
AAssign.FieldInfo := FldInfo;
if TryAnalyseFieldElemWrite(AAssign, FldInfo) then
Exit;
ExprType := AnalyseExpr(AAssign.Expr);
CheckTypesMatch(FldInfo.TypeDesc, ExprType, 'field assignment',
AAssign.Line, AAssign.Col);
@ -5893,6 +5937,8 @@ begin
end;
AAssign.FieldInfo := FldInfo;
if TryAnalyseFieldElemWrite(AAssign, FldInfo) then
Exit;
{ Set-literal RHS into a tySet field — analyse with set context. }
if (FldInfo.TypeDesc.Kind = tySet) and (AAssign.Expr is TArrayLiteralExpr) then
begin
@ -9293,16 +9339,45 @@ end;
procedure TSemanticAnalyser.AnalyseStaticSubscriptAssign(AStmt: TStaticSubscriptAssign);
var
Sym: TSymbol;
ArrType: TStaticArrayTypeDesc;
IdxType: TTypeDesc;
ValType: TTypeDesc;
Sym: TSymbol;
ArrType: TStaticArrayTypeDesc;
IdxType: TTypeDesc;
ValType: TTypeDesc;
BaseInfo: TFieldInfo;
ElemT: TTypeDesc;
begin
Sym := FTable.Lookup(AStmt.ArrayName);
if Sym = nil then
begin
{ Implicit Self.Field[I] := V — ArrayName is an array-typed field of the
current class. }
if FCurrentClass <> nil then
begin
BaseInfo := FCurrentClass.FindField(AStmt.ArrayName);
if (BaseInfo <> nil) and
(BaseInfo.TypeDesc <> nil) and
(BaseInfo.TypeDesc.Kind in [tyDynArray, tyStaticArray]) then
begin
AStmt.IsImplicitSelf := True;
AStmt.ImplicitFieldInfo := BaseInfo;
AStmt.ResolvedArrayType := BaseInfo.TypeDesc;
if BaseInfo.TypeDesc.Kind = tyDynArray then
ElemT := TDynArrayTypeDesc(BaseInfo.TypeDesc).ElementType
else
ElemT := TStaticArrayTypeDesc(BaseInfo.TypeDesc).ElementType;
IdxType := AnalyseExpr(AStmt.IndexExpr);
if not IdxType.IsNumeric() then
SemanticError('Array index must be numeric', AStmt.Line, AStmt.Col);
ValType := AnalyseExpr(AStmt.ValueExpr);
CheckTypesMatch(ElemT, ValType,
Format('''%s'' element', [AStmt.ArrayName]), AStmt.Line, AStmt.Col);
Exit;
end;
end;
SemanticError(
Format('Undeclared variable ''%s''', [AStmt.ArrayName]),
AStmt.Line, AStmt.Col);
end;
AStmt.ArrayName := Sym.Name; { normalise to declared casing }
{ PChar subscript write: P[I] := Integer — storeb at ptr + I }
if Sym.TypeDesc.Kind = tyPChar then

98
compiler/src/test/pascal/cp.test.dynarray.pas
View file

@ -68,6 +68,14 @@ type
procedure TestParse_DynArray_RecordElem_FieldAssign_Accepted;
procedure TestCodegen_DynArray_RecordElem_Write_FieldwiseCopy;
procedure TestCodegen_DynArray_RecordElem_FieldAssign_StringARC;
{ ------------------------------------------------------------------ }
{ Array-typed FIELDS: r.A[i] := v writes the element, not the array }
{ ------------------------------------------------------------------ }
procedure TestSemantic_RecordField_DynArrayElemAssign_Accepted;
procedure TestParse_ChainedField_DynArrayElemAssign_Accepted;
procedure TestCodegen_RecordField_DynArrayElemWrite_StoresElement;
procedure TestCodegen_ClassField_DynArrayElemWrite_StoresElement;
end;
implementation
@ -551,6 +559,96 @@ begin
Self.CountOccurrences(IR, 'call $_StringRelease') > 0);
end;
procedure TDynArrayTests.TestSemantic_RecordField_DynArrayElemAssign_Accepted;
var Prog: TProgram;
begin
{ r.A[0] := 10 used to fail semantic with "expected 'array of Integer'
but got 'Integer'" — the subscript was treated as an indexed-property
index and dropped from the LHS type. }
Prog := AnalyseSrc('''
program P;
type
TIA = array of Integer;
TR = record A: TIA; end;
var r: TR;
begin
SetLength(r.A, 3);
r.A[0] := 10;
end.
''');
AssertNotNil('record-field element assign analyses', Prog);
Prog.Free();
end;
procedure TDynArrayTests.TestParse_ChainedField_DynArrayElemAssign_Accepted;
var Prog: TProgram;
begin
{ c.N.A[0] := 7 used to fail parse with "Expected 'end' but got '['" —
the chained L-value walker refused a subscript after the final field. }
Prog := ParseSrc('''
program P;
type
TIA = array of Integer;
TInner = record A: TIA; end;
TC = class N: TInner; end;
var c: TC;
begin
c := TC.Create();
SetLength(c.N.A, 3);
c.N.A[0] := 7;
end.
''');
AssertNotNil('chained field element assign parses', Prog);
Prog.Free();
end;
procedure TDynArrayTests.TestCodegen_RecordField_DynArrayElemWrite_StoresElement;
var IR: string;
begin
IR := GenIR('''
program P;
type
TIA = array of Integer;
TR = record A: TIA; end;
procedure Foo;
var r: TR;
begin
SetLength(r.A, 3);
r.A[1] := 10;
end;
begin
end.
''');
AssertTrue('element offset arithmetic emitted',
Self.CountOccurrences(IR, 'mul') > 0);
AssertTrue('integer element stored with storew',
Self.CountOccurrences(IR, 'storew') > 0);
end;
procedure TDynArrayTests.TestCodegen_ClassField_DynArrayElemWrite_StoresElement;
var IR: string;
begin
IR := GenIR('''
program P;
type
TIA = array of Integer;
TC = class A: TIA; end;
procedure Foo;
var c: TC;
begin
c := TC.Create();
SetLength(c.A, 3);
c.A[1] := 10;
end;
begin
end.
''');
AssertTrue('element offset arithmetic emitted',
Self.CountOccurrences(IR, 'mul') > 0);
AssertTrue('integer element stored with storew',
Self.CountOccurrences(IR, 'storew') > 0);
end;
initialization
RegisterTest(TDynArrayTests);

157
compiler/src/test/pascal/cp.test.e2e.records.pas
View file

@ -45,6 +45,12 @@ type
procedure TestRun_DynArrayRecordElem_CopyNoAlias;
procedure TestRun_StaticArrayRecordElem_FieldAssignAndRead;
procedure TestRun_DynArrayClassElem_MethodCallStmt;
procedure TestRun_RecordField_DynArrayElemWrite;
procedure TestRun_ClassField_DynArrayElemWrite_AllReceiverShapes;
procedure TestRun_NestedChain_DynArrayElemWrite;
procedure TestRun_SubscriptChain_FieldElemWrite;
procedure TestRun_RecordField_StaticArrayElemWrite;
procedure TestRun_RecordField_DynArrayOfString_ElemWrite_ARC;
end;
implementation
@ -874,6 +880,157 @@ begin
AssertRunsOnAll(SrcDynClassElemMethodCall, '2' + LE, 0);
end;
const
SrcRecFieldDynElemWrite = '''
program P;
type
TIA = array of Integer;
TR = record A: TIA; end;
var r: TR;
begin
SetLength(r.A, 3);
r.A[0] := 10;
r.A[1] := 20;
r.A[2] := r.A[0] + r.A[1];
writeln(r.A[0]);
writeln(r.A[1]);
writeln(r.A[2]);
end.
''';
SrcClassFieldDynElemWrite = '''
program P;
type
TIA = array of Integer;
TC = class
A: TIA;
procedure Fill;
end;
procedure TC.Fill;
begin
SetLength(A, 3);
A[0] := 42;
Self.A[1] := 43;
A[2] := A[0] + Self.A[1];
end;
var c: TC;
begin
c := TC.Create();
c.Fill;
writeln(c.A[0]);
writeln(c.A[1]);
writeln(c.A[2]);
c.A[0] := 7;
writeln(c.A[0]);
end.
''';
SrcNestedChainDynElemWrite = '''
program P;
type
TIA = array of Integer;
TInner = record A: TIA; end;
TC = class N: TInner; end;
var c: TC;
begin
c := TC.Create();
SetLength(c.N.A, 3);
c.N.A[0] := 7;
c.N.A[1] := 8;
writeln(c.N.A[0]);
writeln(c.N.A[1]);
end.
''';
SrcSubscriptChainFieldElemWrite = '''
program P;
type
TIA = array of Integer;
TR = record A: TIA; end;
var
rs: array of TR;
begin
SetLength(rs, 2);
SetLength(rs[1].A, 3);
rs[1].A[2] := 99;
writeln(rs[1].A[2]);
end.
''';
SrcRecFieldStaticElemWrite = '''
program P;
type
TR = record S: array[0..2] of Integer; end;
var r: TR;
begin
r.S[0] := 5;
r.S[1] := 6;
r.S[2] := r.S[0] + r.S[1];
writeln(r.S[0]);
writeln(r.S[1]);
writeln(r.S[2]);
end.
''';
SrcRecFieldDynStrElemWrite = '''
program P;
type
TSA = array of String;
TR = record N: TSA; end;
var
r: TR;
s: String;
begin
SetLength(r.N, 2);
s := 'wor';
r.N[0] := 'hello';
r.N[1] := s + 'ld';
r.N[0] := 'bye';
writeln(r.N[0]);
writeln(r.N[1]);
end.
''';
procedure TE2ERecordsTests.TestRun_RecordField_DynArrayElemWrite;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcRecFieldDynElemWrite,
'10' + LE + '20' + LE + '30' + LE, 0);
end;
procedure TE2ERecordsTests.TestRun_ClassField_DynArrayElemWrite_AllReceiverShapes;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcClassFieldDynElemWrite,
'42' + LE + '43' + LE + '85' + LE + '7' + LE, 0);
end;
procedure TE2ERecordsTests.TestRun_NestedChain_DynArrayElemWrite;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcNestedChainDynElemWrite, '7' + LE + '8' + LE, 0);
end;
procedure TE2ERecordsTests.TestRun_SubscriptChain_FieldElemWrite;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcSubscriptChainFieldElemWrite, '99' + LE, 0);
end;
procedure TE2ERecordsTests.TestRun_RecordField_StaticArrayElemWrite;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcRecFieldStaticElemWrite,
'5' + LE + '6' + LE + '11' + LE, 0);
end;
procedure TE2ERecordsTests.TestRun_RecordField_DynArrayOfString_ElemWrite_ARC;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
AssertRunsOnAll(SrcRecFieldDynStrElemWrite,
'bye' + LE + 'world' + LE, 0);
end;
initialization
RegisterTest(TE2ERecordsTests);

24
docs/grammar.ebnf
View file

@ -666,11 +666,12 @@ StaticSubscriptAssign
* (SubscriptMethodCall). Examples:
* a[0].Name := 'x'; a[i].Inner.N := 5;
* a[0].Bump; a[i].Items.Add(x);
* A terminating subscript on the LHS of ASSIGN (a[i].Items[j] := v) is
* not yet supported. *)
* a[i].Arr[j] := v; — element write into an array-typed field
* A terminating subscript directly over another subscript
* (a[i][j] := v) is not yet supported on the LHS of ASSIGN. *)
SubscriptFieldAssign
= IDENT LBRACKET Expr RBRACKET { SubscriptSuffix }
DOT IDENT ASSIGN Expr
DOT IDENT [ LBRACKET Expr RBRACKET ] ASSIGN Expr
;
SubscriptMethodCall
@ -761,10 +762,19 @@ MethodCall
* - Followed by ASSIGN or LBRACKET ASSIGN → FieldAssignment (plain or indexed)
* - Otherwise → MethodCall
*
* When IDENT DOT IDENT is followed by LBRACKET, the parser checks whether the
* member is an indexed property (symbol table lookup). If it is, LBRACKET Expr
* RBRACKET is consumed as the index; the result is an indexed property access.
* A following ASSIGN makes it an IndexedPropWrite; absence of ASSIGN is a read. *)
* The LBRACKET Expr RBRACKET ASSIGN form covers two cases, disambiguated by
* the semantic pass: when the member is an indexed property the subscript is
* the property index (setter call); when the member is an ARRAY-TYPED FIELD
* (dynamic or static) the subscript selects the element to assign:
* r.A[0] := 10; c.Buf[i] := b; Self.A[1] := x;
* The same applies after a chain (c.N.A[0] := 7 — see MethodCall chains) and
* to a bare implicit-Self field inside a method (A[0] := v parses as
* StaticSubscriptAssign and resolves to the Self field).
*
* When IDENT DOT IDENT is followed by LBRACKET in a READ position, the parser
* checks whether the member is an indexed property (symbol table lookup). If
* it is, LBRACKET Expr RBRACKET is consumed as the index; the result is an
* indexed property access. *)
Assignment
= IDENT ASSIGN Expr

22
tools/bif-coverage/bif-coverage.status
View file

@ -176,25 +176,27 @@ TFieldAssignment.IsGlobal safe
TFieldAssignment.IsVarParam safe
TFieldAssignment.PropIndexExpr serialise
TFieldAssignment.PropOwnerType safe
TFieldAssignment.IsElemWrite safe
# TStaticSubscriptAssign (uAST.pas:367)
# TStaticSubscriptAssign (uAST.pas:370)
TStaticSubscriptAssign.ArrayName serialise
TStaticSubscriptAssign.IndexExpr serialise
TStaticSubscriptAssign.ValueExpr serialise
TStaticSubscriptAssign.IsGlobal safe
TStaticSubscriptAssign.IsImplicitSelf safe
# TPointerWriteStmt (uAST.pas:378)
# TPointerWriteStmt (uAST.pas:383)
TPointerWriteStmt.PtrExpr serialise
TPointerWriteStmt.ValExpr serialise
# TProcCall (uAST.pas:386)
# TProcCall (uAST.pas:391)
TProcCall.Name serialise
TProcCall.Args serialise
TProcCall.IsImplicitSelfMethod safe
TProcCall.IsIndirectCall safe
TProcCall.IndirectCallIsGlobal safe
# TFuncCallExpr (uAST.pas:399)
# TFuncCallExpr (uAST.pas:404)
TFuncCallExpr.Name serialise
TFuncCallExpr.Args serialise
TFuncCallExpr.IsImplicitSelfMethod safe
@ -204,18 +206,18 @@ TFuncCallExpr.IsBuiltinHasClassAttr safe
TFuncCallExpr.HasClassAttrClass safe
TFuncCallExpr.HasClassAttrAttr safe
# TIndirectFuncCallExpr (uAST.pas:425)
# TIndirectFuncCallExpr (uAST.pas:430)
TIndirectFuncCallExpr.CalleeExpr serialise
TIndirectFuncCallExpr.Args serialise
# TDerefExpr (uAST.pas:435)
# TDerefExpr (uAST.pas:440)
TDerefExpr.Expr serialise
# TAddrOfExpr (uAST.pas:442)
# TAddrOfExpr (uAST.pas:447)
TAddrOfExpr.Expr serialise
TAddrOfExpr.ResolvedFreeRoutine safe
# TMethodCallStmt (uAST.pas:454)
# TMethodCallStmt (uAST.pas:459)
TMethodCallStmt.ObjectName serialise
TMethodCallStmt.Name serialise
TMethodCallStmt.Args serialise
@ -226,11 +228,11 @@ TMethodCallStmt.IsVarParam safe
TMethodCallStmt.IsBuiltinToString safe
TMethodCallStmt.IsProcFieldCall safe
# TInheritedCallStmt (uAST.pas:481)
# TInheritedCallStmt (uAST.pas:486)
TInheritedCallStmt.Name serialise
TInheritedCallStmt.Args serialise
# TMethodCallExpr (uAST.pas:671)
# TMethodCallExpr (uAST.pas:676)
TMethodCallExpr.ObjectName serialise
TMethodCallExpr.Name serialise
TMethodCallExpr.Args serialise