From 5f0fbb76430d20c0a745b875fb71f5c375e91197 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 11 Jun 2026 09:19:35 +0100 Subject: [PATCH] =?UTF-8?q?fix:=20element=20access=20through=20array-typed?= =?UTF-8?q?=20fields=20=E2=80=94=20r.A[i],=20c.N.A[i],=20SetLength(r.A)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- .../pascal/blaise.codegen.native.x86_64.pas | 258 +++++++++++++++++- .../src/main/pascal/blaise.codegen.qbe.pas | 192 +++++++++++-- compiler/src/main/pascal/uAST.pas | 7 +- compiler/src/main/pascal/uParser.pas | 43 +++ compiler/src/main/pascal/uSemantic.pas | 83 +++++- compiler/src/test/pascal/cp.test.dynarray.pas | 98 +++++++ .../src/test/pascal/cp.test.e2e.records.pas | 157 +++++++++++ docs/grammar.ebnf | 24 +- tools/bif-coverage/bif-coverage.status | 22 +- 9 files changed, 832 insertions(+), 52 deletions(-) diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index e35edd9..046accf 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -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])); diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 032cfb5..e83231f 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -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); diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index 62addcc..a6c59f1 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -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; diff --git a/compiler/src/main/pascal/uParser.pas b/compiler/src/main/pascal/uParser.pas index 8a457fc..783881b 100644 --- a/compiler/src/main/pascal/uParser.pas +++ b/compiler/src/main/pascal/uParser.pas @@ -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; diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index ba4c90d..7d836f5 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -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 diff --git a/compiler/src/test/pascal/cp.test.dynarray.pas b/compiler/src/test/pascal/cp.test.dynarray.pas index 4b2f78b..fd8a6ff 100644 --- a/compiler/src/test/pascal/cp.test.dynarray.pas +++ b/compiler/src/test/pascal/cp.test.dynarray.pas @@ -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); diff --git a/compiler/src/test/pascal/cp.test.e2e.records.pas b/compiler/src/test/pascal/cp.test.e2e.records.pas index 78dc459..e14214d 100644 --- a/compiler/src/test/pascal/cp.test.e2e.records.pas +++ b/compiler/src/test/pascal/cp.test.e2e.records.pas @@ -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); diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index eb85d97..31abf38 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -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 diff --git a/tools/bif-coverage/bif-coverage.status b/tools/bif-coverage/bif-coverage.status index 3411092..236f247 100644 --- a/tools/bif-coverage/bif-coverage.status +++ b/tools/bif-coverage/bif-coverage.status @@ -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