fix(parser): accept parenthesised lvalue as assignment target
A statement beginning with '(' was rejected ("Expected statement"), so a
parenthesised cast could not be an assignment TARGET:
(a as TB).FX := 42; -> Parse error
Reading the same expression worked, and the hard-cast target TB(a).FX := 42
worked, so only this statement-parser entry point was missing.
ParseStmt now handles a leading '(' by parsing the parenthesised expression
and requiring a '.Field := Expr' suffix, building a TFieldAssignment whose
receiver is that expression (ObjExpr) — the same AST + semantic + codegen path
already used for element-field writes (a[i].F := v). No AST/semantic/codegen
change was needed; the gap was purely the parser.
Found by the e2e test-hardening sweep of the inheritance cluster. Regression:
TE2EMiscTests.TestRun_ParenCastAsAssignmentTarget, run on BOTH backends.
docs/grammar.ebnf FieldAssignment rule updated.
All three fixpoints + full suite (3223 tests) pass.
This commit is contained in:
parent
74f71023da
commit
236736a3be
|
|
@ -2173,6 +2173,7 @@ var
|
|||
DerefNode: TDerefExpr;
|
||||
SecondIdent: string;
|
||||
FldNode: TFieldAccessExpr;
|
||||
ParenExpr: TASTExpr;
|
||||
InnerFld: TFieldAccessExpr;
|
||||
CastRcv: TASTExpr;
|
||||
FCallNode: TFuncCallExpr;
|
||||
|
|
@ -2267,6 +2268,44 @@ begin
|
|||
Exit(ParseCompoundStmt());
|
||||
end;
|
||||
|
||||
{ A statement that begins with '(' is an assignment whose lvalue is a
|
||||
parenthesised expression, e.g. a typecast target: (a as TB).FX := V.
|
||||
Parse the parenthesised expression, then require a '.Field := Expr'
|
||||
suffix and build a TFieldAssignment whose receiver is that expression
|
||||
(the same ObjExpr path used for element-field writes). }
|
||||
if Check(tkLParen) then
|
||||
begin
|
||||
Line := FCurrent.Line;
|
||||
Col := FCurrent.Col;
|
||||
Advance(); { consume '(' }
|
||||
ParenExpr := Self.ParseExpr();
|
||||
try
|
||||
Expect(tkRParen);
|
||||
if not Check(tkDot) then
|
||||
raise EParseError.Create(Format(
|
||||
'Expected ''.'' after parenthesised assignment target at line %d col %d in %s',
|
||||
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
|
||||
Advance(); { consume '.' }
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.Create(Format(
|
||||
'Expected field name at line %d col %d in %s',
|
||||
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
|
||||
SecondIdent := FCurrent.Value;
|
||||
Advance();
|
||||
Expect(tkAssign);
|
||||
except
|
||||
ParenExpr.Free();
|
||||
raise;
|
||||
end;
|
||||
FldAssign := TFieldAssignment.Create();
|
||||
FldAssign.Line := Line;
|
||||
FldAssign.Col := Col;
|
||||
FldAssign.FieldName := SecondIdent;
|
||||
FldAssign.ObjExpr := ParenExpr;
|
||||
FldAssign.Expr := Self.ParseExpr();
|
||||
Exit(FldAssign);
|
||||
end;
|
||||
|
||||
if not Check(tkIdent) then
|
||||
raise EParseError.Create(Format(
|
||||
'Expected statement at line %d col %d in %s',
|
||||
|
|
|
|||
|
|
@ -104,6 +104,10 @@ type
|
|||
function and using its result (Result := inherited F() + ...). Was a
|
||||
parser gap (inherited only worked as a statement). }
|
||||
procedure TestRun_InheritedFunctionCall_InExpression;
|
||||
|
||||
{ (expr as T).Field := value — a parenthesised cast as an assignment
|
||||
TARGET. Was a parser gap (statements could not start with '('). }
|
||||
procedure TestRun_ParenCastAsAssignmentTarget;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -1119,6 +1123,29 @@ begin
|
|||
AssertRunsOnAll(SrcInheritedExprCall, '105' + LE + '31' + LE, 0);
|
||||
end;
|
||||
|
||||
const
|
||||
{ Assign through a parenthesised cast: (a as TB).FX := 42. The statement
|
||||
parser must accept a leading '(' as an assignment lvalue. }
|
||||
SrcParenCastTarget = '''
|
||||
program Prg;
|
||||
type
|
||||
TBase = class end;
|
||||
TDerived = class(TBase) FX: Integer; end;
|
||||
var a: TBase;
|
||||
begin
|
||||
a := TDerived.Create();
|
||||
(a as TDerived).FX := 42;
|
||||
WriteLn((a as TDerived).FX);
|
||||
a.Free()
|
||||
end.
|
||||
''';
|
||||
|
||||
procedure TE2EMiscTests.TestRun_ParenCastAsAssignmentTarget;
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(SrcParenCastTarget, '42' + LE, 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TE2EMiscTests);
|
||||
|
||||
|
|
|
|||
|
|
@ -849,6 +849,7 @@ PointerWriteStmt
|
|||
|
||||
FieldAssignment
|
||||
= IDENT DOT IDENT [ LBRACKET Expr RBRACKET ] ASSIGN Expr
|
||||
| LPAREN Expr RPAREN DOT IDENT ASSIGN Expr (* parenthesised lvalue, e.g. (a as TB).FX := v *)
|
||||
;
|
||||
|
||||
MethodCall
|
||||
|
|
|
|||
Loading…
Reference in a new issue