From 1bd52ec39a72a8b44b97fc7ffae5e4b45fd29eb5 Mon Sep 17 00:00:00 2001 From: Andrew Haines Date: Wed, 24 Jun 2026 16:44:26 -0400 Subject: [PATCH] feat(semantic+codegen): write through a default array property on a member result MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reading a default array property through a member result already worked (Recv.Member[idx]); the write form Recv.Member[idx] := V did not. A class field reported "Field is not an array — cannot assign to a subscript", and a property reported "Property is read-only", because the write paths only handled array fields and writable properties directly, never a default property on the member's result. Add TryLowerDefaultPropertyWrite: when the assignment target is a class member (field or property) whose type carries a writable default array property and a trailing index is present, lower Recv.Member[idx] := V to (Recv.Member).Default[idx] := V — read the member into an inner object expression and re-target the assignment at the default property's setter. Wired into the field path (TryAnalyseFieldElemWrite, so it covers every receiver form) and the read-only-property path. Class members only; a record getter result is a by-value temp, so a write through it would be discarded. The setter receiver is now an arbitrary expression, so both codegen backends gain an ObjExpr branch in the property-write path (QBE EmitFieldAssignment and the x86-64 native field-assignment): evaluate the receiver expression to get the object pointer instead of loading a named var or Self. e2e tests cover writing through a class field and through a (read-only) property, verified on QBE and native. --- .../pascal/blaise.codegen.native.x86_64.pas | 9 ++- .../src/main/pascal/blaise.codegen.qbe.pas | 6 +- compiler/src/main/pascal/uSemantic.pas | 66 ++++++++++++++++++ .../test/pascal/cp.test.e2e.properties.pas | 68 +++++++++++++++++++ 4 files changed, 147 insertions(+), 2 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 86959a6..b515bbc 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -11886,7 +11886,14 @@ begin begin Self.EmitExprToEax(FA.Expr); Self.Emit(#9'pushq %rax'); - if FA.IsImplicitSelf then + if FA.ObjExpr <> nil then + begin + { Receiver is an arbitrary expression (default-property write through a + property/field result): its value is the object pointer. } + Self.EmitExprToEax(FA.ObjExpr); + Self.Emit(#9'movq %rax, %rdi'); + end + else if FA.IsImplicitSelf then begin Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand('Self')])); if (FA.ImplicitBaseInfo <> nil) and (FA.ImplicitBaseInfo.Offset > 0) then diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 5f971eb..6d0d5ad 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -6093,7 +6093,11 @@ begin if AAssign.PropWriteInfo <> nil then begin ValTemp := EmitExpr(AAssign.Expr); - if AAssign.IsImplicitSelf then + if AAssign.ObjExpr <> nil then + { Receiver is an arbitrary expression (e.g. a default-property write + through a property/field result) — its value is the object pointer. } + SelfPtr := EmitExpr(AAssign.ObjExpr) + else if AAssign.IsImplicitSelf then begin SelfPtr := AllocTemp(); EmitLine(Format(' %s =l loadl %%_var_Self', [SelfPtr])); diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 8dc11cd..a2b4958 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -262,6 +262,8 @@ type procedure AnalyseFieldAssignment(AAssign: TFieldAssignment); function TryAnalyseFieldElemWrite(AAssign: TFieldAssignment; AFldInfo: TFieldInfo): Boolean; + function TryLowerDefaultPropertyWrite(AAssign: TFieldAssignment; + AMemberType: TTypeDesc): Boolean; function FloatBuiltinArgType(const AName: string; AArgType: TTypeDesc; ALine, ACol: Integer): TTypeDesc; procedure AnalyseProcCall(ACall: TProcCall); @@ -7899,6 +7901,14 @@ begin ElemT := TStaticArrayTypeDesc(AFldInfo.TypeDesc).ElementType else begin + { A class field carrying a default array property: the subscript is a write + through that default property, Recv.Field[I] := V → (Recv.Field).Default[I] + := V. Otherwise the subscript is meaningless on this field. } + if TryLowerDefaultPropertyWrite(AAssign, AFldInfo.TypeDesc) then + begin + Result := True; + Exit; + end; SemanticError( Format('Field ''%s'' is not an array — cannot assign to a subscript', [AAssign.FieldName]), @@ -7915,6 +7925,60 @@ begin Result := True; end; +{ Write through a default array property on a member result: + Recv.Member[idx] := V where Member (a field or property) yields a class that + carries a writable `default` indexed property — lower to + (Recv.Member).Default[idx] := V. Reads the member into an inner object + expression (the new ObjExpr receiver) and re-targets the assignment at the + default property's setter. Class members only (a record getter result is a + by-value temp, so a write through it would be discarded). Returns False when + no lowering applies (no trailing index, not a class, or no writable default + property), leaving the caller to handle the member as before. } +function TSemanticAnalyser.TryLowerDefaultPropertyWrite( + AAssign: TFieldAssignment; AMemberType: TTypeDesc): Boolean; +var + DefProp: TPropertyInfo; + DefRT: TRecordTypeDesc; + Inner: TFieldAccessExpr; + IdxType: TTypeDesc; + ValType: TTypeDesc; +begin + Result := False; + if AAssign.PropIndexExpr = nil then + Exit; + if (AMemberType = nil) or (AMemberType.Kind <> tyClass) then + Exit; + DefRT := TRecordTypeDesc(AMemberType); + DefProp := DefRT.FindDefaultProperty(); + if (DefProp = nil) or (DefProp.WriteMethod = '') then + Exit; + { Inner = the member read (the getter / field access), the receiver of the + setter call. Carries the original receiver (RecordName form, or the ObjExpr + receiver if one was already present). } + Inner := TFieldAccessExpr.Create(); + Inner.Line := AAssign.Line; + Inner.Col := AAssign.Col; + Inner.Base := AAssign.ObjExpr; { transfer (nil for the RecordName form) } + Inner.RecordName := AAssign.RecordName; + Inner.FieldName := AAssign.FieldName; + AnalyseExpr(Inner); + { Re-target the assignment at the default property setter on that result. } + AAssign.ObjExpr := Inner; + AAssign.RecordName := ''; + AAssign.FieldName := DefProp.Name; + AAssign.PropWriteInfo := DefProp; + AAssign.PropOwnerType := PropAccessorOwner(DefRT.Name, DefProp.WriteMethod); + AAssign.PropAccessorVSlot := PropAccessorVSlot(DefRT.Name, DefProp.WriteMethod); + IdxType := AnalyseExpr(AAssign.PropIndexExpr); + if DefProp.IndexTypeDesc <> nil then + CheckTypesMatch(DefProp.IndexTypeDesc, IdxType, 'default property index', + AAssign.Line, AAssign.Col); + ValType := AnalyseExpr(AAssign.Expr); + CheckTypesMatch(DefProp.TypeDesc, ValType, 'default property assignment', + AAssign.Line, AAssign.Col); + Result := True; +end; + procedure TSemanticAnalyser.AnalyseFieldAssignment(AAssign: TFieldAssignment); var RecSym: TSymbol; @@ -8113,6 +8177,8 @@ begin AAssign.Line, AAssign.Col); Exit; end + else if TryLowerDefaultPropertyWrite(AAssign, PropInfo.TypeDesc) then + Exit else SemanticError( Format('Property ''%s'' is read-only', [AAssign.FieldName]), diff --git a/compiler/src/test/pascal/cp.test.e2e.properties.pas b/compiler/src/test/pascal/cp.test.e2e.properties.pas index a7e84ca..2927cda 100644 --- a/compiler/src/test/pascal/cp.test.e2e.properties.pas +++ b/compiler/src/test/pascal/cp.test.e2e.properties.pas @@ -39,6 +39,10 @@ type Obj.Prop[I] where Prop returns a class carrying a default property. } procedure TestRun_DefaultProperty_ViaFieldBackedProperty; procedure TestRun_DefaultProperty_ViaMethodBackedProperty; + { Write through a default array property on a member result: + Obj.Field[I] := V and Obj.Prop[I] := V. } + procedure TestRun_DefaultProperty_WriteThroughField; + procedure TestRun_DefaultProperty_WriteThroughProperty; { Static-array field accessed from inside a method (implicit Self). } procedure TestRun_StaticArrayField_ReadInMethod; procedure TestRun_StaticArrayField_WriteInMethod; @@ -371,6 +375,70 @@ begin AssertRunsOnAll(SrcDefaultViaMethodProp, '9' + LE, 0); end; +const + { Write through a class field's default property: Obj.Field[I] := V. } + SrcDefaultWriteField = ''' + program P; + type + TVec = class + FData: array[0..4] of Integer; + function Get(i: Integer): Integer; begin Result := FData[i] end; + procedure Put(i: Integer; v: Integer); begin FData[i] := v end; + property Items[i: Integer]: Integer read Get write Put; default; + end; + TOwner = class + FVec: TVec; + constructor Create; + property Vec: TVec read FVec; + end; + constructor TOwner.Create; begin inherited Create; FVec := TVec.Create end; + var o: TOwner; + begin + o := TOwner.Create; + o.FVec[0] := 3; o.FVec[1] := 4; + WriteLn(o.Vec[0] + o.Vec[1]); + o := nil + end. + '''; + + { Write through a read-only property's result default property: + Obj.Prop[I] := V. } + SrcDefaultWriteProp = ''' + program P; + type + TVec = class + FData: array[0..4] of Integer; + function Get(i: Integer): Integer; begin Result := FData[i] end; + procedure Put(i: Integer; v: Integer); begin FData[i] := v end; + property Items[i: Integer]: Integer read Get write Put; default; + end; + TOwner = class + FVec: TVec; + constructor Create; + property Vec: TVec read FVec; + end; + constructor TOwner.Create; begin inherited Create; FVec := TVec.Create end; + var o: TOwner; + begin + o := TOwner.Create; + o.Vec[0] := 5; o.Vec[1] := 4; + WriteLn(o.Vec[0] + o.Vec[1]); + o := nil + end. + '''; + +procedure TE2EPropertyTests.TestRun_DefaultProperty_WriteThroughField; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcDefaultWriteField, '7' + LE, 0); +end; + +procedure TE2EPropertyTests.TestRun_DefaultProperty_WriteThroughProperty; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcDefaultWriteProp, '9' + LE, 0); +end; + initialization RegisterTest(TE2EPropertyTests);