From 9024ffc7662d35bf74ca489941d0823aff1fcd5d Mon Sep 17 00:00:00 2001 From: Andrew Haines Date: Wed, 24 Jun 2026 16:39:56 -0400 Subject: [PATCH] fix(semantic): read a default array property through a property result MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Recv.Prop[idx] where Prop is a (non-indexed) property whose type carries a default array property previously dropped the index: the parser folds the trailing [idx] into the field-access PropIndexExpr, and the property-read branches in AnalyseFieldAccess returned the property's type without consuming it (Recv.Prop[idx] resolved to the property's class type, e.g. TStringList). A field with a default property already worked via FindIndexedProperty; a property read did not. Add TryLowerDefaultPropertyIndex: when a resolved read property is non-indexed but has a trailing index and its result type has a default property, rewrite Recv.Prop[idx] to (Recv.Prop).Default[idx] — moving the property read into an inner field-access and re-pointing the node at the default property, then re-analysing (which lands on the existing chained indexed-property path). Wired into the field-backed and method-backed property branches (chained receiver, implicit Self, and variable receiver). Reads only; writing through a property-result default property is a separate gap (the write path reports the property read-only). --- compiler/src/main/pascal/uSemantic.pas | 59 ++++++++++++++ .../test/pascal/cp.test.e2e.properties.pas | 77 +++++++++++++++++++ 2 files changed, 136 insertions(+) diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index bac3b79..8dc11cd 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -315,6 +315,8 @@ type function AnalyseExpr(AExpr: TASTExpr): TTypeDesc; function AnalyseBinaryExpr(ABin: TBinaryExpr): TTypeDesc; function AnalyseFieldAccess(AAccess: TFieldAccessExpr): TTypeDesc; + function TryLowerDefaultPropertyIndex(AAccess: TFieldAccessExpr; + APropInfo: TPropertyInfo): TTypeDesc; function AnalyseIsExpr(AExpr: TIsExpr): TTypeDesc; function AnalyseAsExpr(AExpr: TAsExpr): TTypeDesc; function AnalyseSupportsExpr(AExpr: TSupportsExpr): TTypeDesc; @@ -10652,6 +10654,45 @@ begin AExpr.ResolvedType := Result; end; +{ Default array property on a property-read result. The parser folds the + trailing '[idx]' of 'Recv.Prop[idx]' into AAccess.PropIndexExpr, so when Prop + is a (non-indexed) property whose type has a `default` indexed property, the + read above would resolve Recv.Prop and drop the index. Rewrite it as + '(Recv.Prop).Default[idx]': move the property read into a fresh inner + field-access (the getter, no index) and re-point AAccess at the default + property, then re-analyse — which lands on the chained indexed-property path. + Returns the resolved element type, or nil when no lowering applies (the + caller then handles Prop as before). APropInfo is the already-resolved read + property. } +function TSemanticAnalyser.TryLowerDefaultPropertyIndex( + AAccess: TFieldAccessExpr; APropInfo: TPropertyInfo): TTypeDesc; +var + Inner: TFieldAccessExpr; + DefProp: TPropertyInfo; +begin + Result := nil; + if (APropInfo.IndexParamName <> '') or (AAccess.PropIndexExpr = nil) then + Exit; + if not (APropInfo.TypeDesc.Kind in [tyRecord, tyClass]) then + Exit; + DefProp := TRecordTypeDesc(APropInfo.TypeDesc).FindDefaultProperty(); + if (DefProp = nil) or (DefProp.ReadMethod = '') then + Exit; + { Inner = the property getter without the index; carries the receiver. } + Inner := TFieldAccessExpr.Create(); + Inner.Line := AAccess.Line; + Inner.Col := AAccess.Col; + Inner.Base := AAccess.Base; { transfer ownership (may be nil) } + Inner.RecordName := AAccess.RecordName; + Inner.FieldName := AAccess.FieldName; + { Re-point AAccess at the default property on that getter result; the + PropIndexExpr ('[idx]') is left in place as its index. } + AAccess.Base := Inner; + AAccess.RecordName := ''; + AAccess.FieldName := DefProp.Name; + Result := AnalyseFieldAccess(AAccess); +end; + function TSemanticAnalyser.AnalyseFieldAccess(AAccess: TFieldAccessExpr): TTypeDesc; var RecSym: TSymbol; @@ -10694,6 +10735,9 @@ begin PropInfo := RT.FindProperty(AAccess.FieldName); if (PropInfo <> nil) and (PropInfo.ReadField <> '') then begin + Result := TryLowerDefaultPropertyIndex(AAccess, PropInfo); + if Result <> nil then + Exit; AAccess.FieldName := PropInfo.ReadField; AAccess.FieldInfo := RT.FindField(PropInfo.ReadField); Exit(PropInfo.TypeDesc); @@ -10702,6 +10746,9 @@ begin '[idx]' to AAccess.PropIndexExpr when it parses 'Base.Prop[idx]'). } if (PropInfo <> nil) and (PropInfo.ReadMethod <> '') then begin + Result := TryLowerDefaultPropertyIndex(AAccess, PropInfo); + if Result <> nil then + Exit; if PropInfo.IndexParamName <> '' then begin if AAccess.PropIndexExpr = nil then @@ -10838,6 +10885,9 @@ begin begin if PropInfo.ReadField <> '' then begin + Result := TryLowerDefaultPropertyIndex(AAccess, PropInfo); + if Result <> nil then + Exit; AAccess.FieldName := PropInfo.ReadField; AAccess.FieldInfo := RT.FindField(PropInfo.ReadField); Result := PropInfo.TypeDesc; @@ -10847,6 +10897,9 @@ begin else if PropInfo.ReadMethod <> '' then begin { Method-backed read (includes indexed properties) } + Result := TryLowerDefaultPropertyIndex(AAccess, PropInfo); + if Result <> nil then + Exit; if PropInfo.IndexParamName <> '' then begin if AAccess.PropIndexExpr = nil then @@ -11073,6 +11126,9 @@ begin if PropInfo.ReadField <> '' then begin { Field-backed read: redirect to the backing field } + Result := TryLowerDefaultPropertyIndex(AAccess, PropInfo); + if Result <> nil then + Exit; AAccess.FieldName := PropInfo.ReadField; AAccess.FieldInfo := RT.FindField(PropInfo.ReadField); Result := PropInfo.TypeDesc; @@ -11082,6 +11138,9 @@ begin else if PropInfo.ReadMethod <> '' then begin { Method-backed read (includes indexed properties) } + Result := TryLowerDefaultPropertyIndex(AAccess, PropInfo); + if Result <> nil then + Exit; if PropInfo.IndexParamName <> '' then begin if AAccess.PropIndexExpr = nil then diff --git a/compiler/src/test/pascal/cp.test.e2e.properties.pas b/compiler/src/test/pascal/cp.test.e2e.properties.pas index 1c579e9..a7e84ca 100644 --- a/compiler/src/test/pascal/cp.test.e2e.properties.pas +++ b/compiler/src/test/pascal/cp.test.e2e.properties.pas @@ -35,6 +35,10 @@ type procedure TestRun_DefaultProperty_ReadWrite; procedure TestRun_DefaultProperty_StringElement; procedure TestRun_DefaultProperty_Inherited; + { Default array property read through a property-read result: + Obj.Prop[I] where Prop returns a class carrying a default property. } + procedure TestRun_DefaultProperty_ViaFieldBackedProperty; + procedure TestRun_DefaultProperty_ViaMethodBackedProperty; { Static-array field accessed from inside a method (implicit Self). } procedure TestRun_StaticArrayField_ReadInMethod; procedure TestRun_StaticArrayField_WriteInMethod; @@ -294,6 +298,79 @@ begin AssertRunsOnAll(SrcDefaultInherited, '12' + LE, 0); end; +const + { Obj.Prop[I] where Prop is a field-backed property returning a class with a + default array property — reads through the property result. } + SrcDefaultViaFieldProp = ''' + 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; + FVec.Put(0, 3); FVec.Put(1, 4); + end; + var o: TOwner; + begin + o := TOwner.Create; + WriteLn(o.Vec[0] + o.Vec[1]); + o := nil + end. + '''; + + { Same, but Prop is a method-backed (getter) property. } + SrcDefaultViaMethodProp = ''' + 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; + function GetVec: TVec; begin Result := FVec end; + property Vec: TVec read GetVec; + end; + constructor TOwner.Create; + begin + inherited Create; + FVec := TVec.Create; + FVec.Put(0, 5); FVec.Put(1, 4); + end; + var o: TOwner; + begin + o := TOwner.Create; + WriteLn(o.Vec[0] + o.Vec[1]); + o := nil + end. + '''; + +procedure TE2EPropertyTests.TestRun_DefaultProperty_ViaFieldBackedProperty; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcDefaultViaFieldProp, '7' + LE, 0); +end; + +procedure TE2EPropertyTests.TestRun_DefaultProperty_ViaMethodBackedProperty; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcDefaultViaMethodProp, '9' + LE, 0); +end; + initialization RegisterTest(TE2EPropertyTests);