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

fix(semantic): read a default array property through a property result

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

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

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

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

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