fix(parser,codegen): Self.Field[Index].SubField := ... parse and codegen
The parser's Ident.Ident[Index] path unconditionally expected ']:=' after the subscript, rejecting chains like Self.FStack[0].Count := value. Add a chain loop after ']' that handles '.Field :=', '.Method()', and further '[Index]' suffixes. Additionally, the QBE backend's EmitInstancePtr did not handle TFieldAccessExpr nodes with IsArrayAccess set — it returned the field slot address instead of the dereferenced array element pointer. Delegate to EmitExpr when IsArrayAccess is true so the dynarray pointer is loaded and the element offset is computed correctly.
This commit is contained in:
Graeme Geldenhuys
parent
57c1699d32
commit
baf5079d6d
|
|
@ -4642,8 +4642,9 @@ begin
|
|||
if AExpr is TFieldAccessExpr then
|
||||
begin
|
||||
Fld := TFieldAccessExpr(AExpr);
|
||||
{ Property-backed access: the result is already a pointer — delegate to EmitExpr }
|
||||
if Fld.PropRead <> nil then
|
||||
{ Property-backed or array-subscripted access: the result is already a
|
||||
pointer — delegate to EmitExpr which handles the full dereference. }
|
||||
if (Fld.PropRead <> nil) or Fld.IsArrayAccess then
|
||||
begin
|
||||
Exit(EmitExpr(Fld));
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -2950,18 +2950,120 @@ begin
|
|||
|
||||
if Check(tkLBracket) then
|
||||
begin
|
||||
{ Indexed property write: Ident '.' Ident '[' Index ']' ':=' Expr }
|
||||
FldAssign := TFieldAssignment.Create();
|
||||
FldAssign.Line := Line;
|
||||
FldAssign.Col := Col;
|
||||
FldAssign.RecordName := Name;
|
||||
FldAssign.FieldName := SecondIdent;
|
||||
{ Ident '.' Ident '[' ... — either an indexed property write
|
||||
(Ident.Field[Index] := Expr) or a subscripted chain with field
|
||||
access (Self.FStack[I].Count := Expr). }
|
||||
Advance(); { consume '[' }
|
||||
FldAssign.PropIndexExpr := ParseExpr();
|
||||
PtrIdNode := TIdentExpr.Create();
|
||||
PtrIdNode.Line := Line;
|
||||
PtrIdNode.Col := Col;
|
||||
PtrIdNode.Name := Name;
|
||||
FldNode := TFieldAccessExpr.Create();
|
||||
FldNode.Line := Line;
|
||||
FldNode.Col := Col;
|
||||
FldNode.Base := PtrIdNode;
|
||||
FldNode.FieldName := SecondIdent;
|
||||
SubNode := TStringSubscriptExpr.Create();
|
||||
SubNode.Line := Line;
|
||||
SubNode.Col := Col;
|
||||
SubNode.StrExpr := FldNode;
|
||||
SubNode.IndexExpr := ParseExpr();
|
||||
Expect(tkRBracket);
|
||||
Expect(tkAssign);
|
||||
FldAssign.Expr := ParseExpr();
|
||||
Result := FldAssign;
|
||||
if Check(tkAssign) then
|
||||
begin
|
||||
{ Indexed property / array-element write: Ident.Field[Index] := Expr.
|
||||
Semantic sets IsElemWrite when the field is an array type. }
|
||||
FldAssign := TFieldAssignment.Create();
|
||||
FldAssign.Line := Line;
|
||||
FldAssign.Col := Col;
|
||||
FldAssign.RecordName := Name;
|
||||
FldAssign.FieldName := SecondIdent;
|
||||
FldAssign.PropIndexExpr := SubNode.IndexExpr;
|
||||
SubNode.IndexExpr := nil;
|
||||
SubNode.Free();
|
||||
SubNode := nil;
|
||||
FldNode.Base := nil;
|
||||
PtrIdNode.Free();
|
||||
PtrIdNode := nil;
|
||||
FldNode.Free();
|
||||
FldNode := nil;
|
||||
Advance(); { consume ':=' }
|
||||
FldAssign.Expr := ParseExpr();
|
||||
Result := FldAssign;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Chain after subscript: Self.FStack[I].Count := ... or
|
||||
Self.FStack[I].Method(args) }
|
||||
ChainBase := SubNode;
|
||||
SubNode := nil;
|
||||
try
|
||||
repeat
|
||||
if Check(tkDot) then
|
||||
begin
|
||||
Advance(); { consume '.' }
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.Create(Format(
|
||||
'Expected field or method name at line %d col %d in %s',
|
||||
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
|
||||
SecondIdent := FCurrent.Value;
|
||||
Advance();
|
||||
if Check(tkAssign) then
|
||||
begin
|
||||
Advance(); { consume ':=' }
|
||||
FldAssign := TFieldAssignment.Create();
|
||||
FldAssign.Line := Line;
|
||||
FldAssign.Col := Col;
|
||||
FldAssign.FieldName := SecondIdent;
|
||||
FldAssign.ObjExpr := ChainBase;
|
||||
ChainBase := nil;
|
||||
FldAssign.Expr := ParseExpr();
|
||||
Exit(FldAssign);
|
||||
end;
|
||||
if Check(tkLParen) then
|
||||
begin
|
||||
MCall := TMethodCallStmt.Create();
|
||||
MCall.Line := Line;
|
||||
MCall.Col := Col;
|
||||
MCall.ObjectName := '';
|
||||
MCall.Name := SecondIdent;
|
||||
MCall.ObjExpr := ChainBase;
|
||||
ChainBase := nil;
|
||||
Advance(); { consume '(' }
|
||||
if not Check(tkRParen) then
|
||||
ParseMethodCallArgList(MCall);
|
||||
Expect(tkRParen);
|
||||
Exit(MCall);
|
||||
end;
|
||||
InnerFld := TFieldAccessExpr.Create();
|
||||
InnerFld.Line := FCurrent.Line;
|
||||
InnerFld.Col := FCurrent.Col;
|
||||
InnerFld.Base := ChainBase;
|
||||
InnerFld.FieldName := SecondIdent;
|
||||
ChainBase := InnerFld;
|
||||
end
|
||||
else if Check(tkLBracket) then
|
||||
begin
|
||||
Advance(); { consume '[' }
|
||||
SubNode := TStringSubscriptExpr.Create();
|
||||
SubNode.Line := FCurrent.Line;
|
||||
SubNode.Col := FCurrent.Col;
|
||||
SubNode.StrExpr := ChainBase;
|
||||
ChainBase := SubNode;
|
||||
SubNode.IndexExpr := ParseExpr();
|
||||
Expect(tkRBracket);
|
||||
end
|
||||
else
|
||||
Break;
|
||||
until False;
|
||||
except
|
||||
ChainBase.Free();
|
||||
raise;
|
||||
end;
|
||||
raise EParseError.Create(Format(
|
||||
'Expected '':='' or ''('' after chain at line %d col %d in %s',
|
||||
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
|
||||
end;
|
||||
end
|
||||
else if Check(tkAssign) then
|
||||
begin
|
||||
|
|
|
|||
|
|
@ -134,6 +134,7 @@ type
|
|||
{ ClassCreate builtin still works (backwards compat) and now dispatches
|
||||
the ctor body via vtable too. }
|
||||
procedure TestRun_ClassCreate_StillWorks;
|
||||
procedure TestRun_SelfIndexedRecordFieldAssign;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -1940,6 +1941,55 @@ begin
|
|||
'bar' + LE + 'foo' + LE, 0);
|
||||
end;
|
||||
|
||||
procedure TE2EClasses2Tests.TestRun_SelfIndexedRecordFieldAssign;
|
||||
const
|
||||
Src =
|
||||
'program test_self_idx_rec;' + LE +
|
||||
'type' + LE +
|
||||
' TFrame = record' + LE +
|
||||
' Count: Integer;' + LE +
|
||||
' end;' + LE +
|
||||
' TThing = class' + LE +
|
||||
' FStack: array of TFrame;' + LE +
|
||||
' procedure Go;' + LE +
|
||||
' end;' + LE +
|
||||
'procedure TThing.Go;' + LE +
|
||||
'begin' + LE +
|
||||
' SetLength(Self.FStack, 1);' + LE +
|
||||
' Self.FStack[0].Count := Self.FStack[0].Count + 1;' + LE +
|
||||
' WriteLn(Self.FStack[0].Count)' + LE +
|
||||
'end;' + LE +
|
||||
'var t: TThing;' + LE +
|
||||
'begin' + LE +
|
||||
' t := TThing.Create();' + LE +
|
||||
' t.Go()' + LE +
|
||||
'end.';
|
||||
SrcDirect =
|
||||
'program test_self_idx_direct;' + LE +
|
||||
'type' + LE +
|
||||
' TThing = class' + LE +
|
||||
' FItems: array of Integer;' + LE +
|
||||
' procedure Go;' + LE +
|
||||
' end;' + LE +
|
||||
'procedure TThing.Go;' + LE +
|
||||
'begin' + LE +
|
||||
' SetLength(Self.FItems, 2);' + LE +
|
||||
' Self.FItems[0] := 42;' + LE +
|
||||
' Self.FItems[1] := 99;' + LE +
|
||||
' WriteLn(Self.FItems[0]);' + LE +
|
||||
' WriteLn(Self.FItems[1])' + LE +
|
||||
'end;' + LE +
|
||||
'var t: TThing;' + LE +
|
||||
'begin' + LE +
|
||||
' t := TThing.Create();' + LE +
|
||||
' t.Go()' + LE +
|
||||
'end.';
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(SrcDirect, '42' + LE + '99' + LE, 0);
|
||||
AssertRunsOnAll(Src, '1' + LE, 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TE2EClasses2Tests);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue