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

fix(semantic): reject procedural/record/class types as WriteLn/Write arguments

Browse source 
WriteLn/Write had no type-check on their argument list — a procedural
variable (or any other unprintable type: record, class, interface, array)
was silently accepted by the semantic pass and handed to the codegen,
which emitted it as an integer (the raw code pointer).  The native backend
printed the address; QBE rejected the IR with "invalid argument".

Add a post-analyse check in the Write/WriteLn branch: after resolving each
argument's type, reject tyProcedural, tyRecord, tyClass, tyInterface,
tyMetaClass, tyStaticArray, tyDynArray, tyOpenArray, and tyPointer with
a clear error message matching FPC's behaviour.

Adds one semantic unit test covering the procedural-variable case.
This commit is contained in:
Graeme Geldenhuys 2026-06-12 17:46:56 +01:00
parent 1b0afaf3d3
commit b3024facc0
2 changed files with 30 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -6928,9 +6928,21 @@ begin
end
else
begin
{ Other built-ins (WriteLn/Write/etc.) — just analyse arg expressions }
{ Other built-ins (WriteLn/Write/etc.) — analyse args, then for
Write/WriteLn specifically reject types that have no text representation. }
for I := 0 to ACall.Args.Count - 1 do
AnalyseExpr(TASTExpr(ACall.Args.Items[I]));
begin
ArgType := AnalyseExpr(TASTExpr(ACall.Args.Items[I]));
if SameText(ACall.Name, 'WriteLn') or SameText(ACall.Name, 'Write') then
if (ArgType <> nil) and
(ArgType.Kind in [tyProcedural, tyRecord, tyClass, tyInterface,
tyMetaClass, tyStaticArray, tyDynArray,
tyOpenArray, tyPointer, tyNil]) then
SemanticError(
Format('Cannot pass a value of type ''%s'' to ''%s''',
[ArgType.Name, ACall.Name]),
ACall.Line, ACall.Col);
end;
end;
end;
end;

16
compiler/src/test/pascal/cp.test.semantic.pas
View file

@ -66,6 +66,7 @@ type
procedure TestProcCall_WriteLn_NoArgs_OK;
procedure TestProcCall_WriteLn_StringArg_OK;
procedure TestProcCall_WriteLn_IntArg_OK;
procedure TestProcCall_WriteLn_ProceduralArg_RaisesError;
procedure TestProcCall_UndeclaredProc_RaisesError;
{ Full program analysis }
@ -421,6 +422,21 @@ begin
Analyse('program P; begin WriteLn(99) end.').Free();
end;
procedure TSemanticTests.TestProcCall_WriteLn_ProceduralArg_RaisesError;
begin
AnalyseExpectError(
'''
program TestProc;
type TProc = procedure(A, B: Integer);
procedure Dummy(A, B: Integer); begin end;
var V: TProc;
begin
V := @Dummy;
WriteLn(V)
end.
''');
end;
procedure TSemanticTests.TestProcCall_UndeclaredProc_RaisesError;
begin
AnalyseExpectError('program P; begin NoSuchProc end.');