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

feat(semantic+codegen): write through a default array property on a member result

Browse source 
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.
This commit is contained in:
Andrew Haines 2026-06-24 16:44:26 -04:00 committed by Graeme Geldenhuys
parent 9024ffc766
commit 1bd52ec39a
4 changed files with 147 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -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

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

@ -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]));

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

@ -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]),

68
compiler/src/test/pascal/cp.test.e2e.properties.pas
View file

@ -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);