diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index 51262ac..f947aa3 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -7113,11 +7113,14 @@ begin ADecl.ResolvedQbeName := ADecl.Name; { Index for call resolution — overloaded names appear multiple times. - Nested procs (those inside another proc's body) are resolved via the + Nested procs (those inside another routine's body) are resolved via the scoped symbol table only; adding them to the global FProcIndex would - make same-named nested procs in different outer procs appear as - ambiguous overloads of each other. } - if FCurrentEnclosingDecl = nil then + make same-named nested procs in different outer routines appear as + ambiguous overloads of each other. A proc is nested when it sits + inside a standalone routine (FCurrentEnclosingDecl set) OR inside a + method body (FCurrentMethodOwner set) — both cases must be excluded + from the global index. } + if (FCurrentEnclosingDecl = nil) and (FCurrentMethodOwner = nil) then RegisterProcDecl(ADecl.Name, ADecl); { Register in symbol table } @@ -11259,6 +11262,43 @@ begin Exit; end; + { Scoped nested routine: a function declared inside another routine's body + is registered in the symbol table only, never in the global FProcIndex / + FProcGroups (so same-named nested procs in sibling outer routines do not + collide as ambiguous overloads). When the call name misses the global + index but the scoped Sym carries its backing decl, resolve directly + against that single decl rather than the overload group. } + if (FProcIndex.IndexOf(AExpr.Name) < 0) and (Sym <> nil) and + (Sym.Decl <> nil) and (Sym.Decl is TMethodDecl) then + begin + MDecl := TMethodDecl(Sym.Decl); + HintBareEnumArgs(AExpr.Name, AExpr.Args); + for I := 0 to AExpr.Args.Count - 1 do + AnalyseExpr(TASTExpr(AExpr.Args.Items[I])); + if (AExpr.Args.Count < MinArity(MDecl)) or + (AExpr.Args.Count > MDecl.Params.Count) then + SemanticError( + Format('''%s'' expects %d argument(s), got %d', + [AExpr.Name, MDecl.Params.Count, AExpr.Args.Count]), + AExpr.Line, AExpr.Col); + for I := 0 to AExpr.Args.Count - 1 do + begin + Par := TMethodParam(MDecl.Params.Items[I]); + if Par.IsVarParam then + begin + ArgType := TASTExpr(AExpr.Args.Items[I]).ResolvedType; + CheckTypesMatch(Par.ResolvedType, ArgType, + Format('var argument %d of ''%s''', [I + 1, AExpr.Name]), + AExpr.Line, AExpr.Col); + end; + end; + RetypeSetLiteralArgs(AExpr.Args, MDecl); + AppendDefaultArgs(AExpr.Args, MDecl, AExpr.Name, AExpr.Line, AExpr.Col); + AExpr.ResolvedDecl := MDecl; + Result := MDecl.ResolvedReturnType; + Exit; + end; + Idx := FProcIndex.IndexOf(AExpr.Name); if Idx < 0 then SemanticError( diff --git a/compiler/src/test/pascal/cp.test.e2e.misc.pas b/compiler/src/test/pascal/cp.test.e2e.misc.pas index 4c9ab34..e0b29d3 100644 --- a/compiler/src/test/pascal/cp.test.e2e.misc.pas +++ b/compiler/src/test/pascal/cp.test.e2e.misc.pas @@ -99,6 +99,15 @@ type with one extra dereference; without it the element address resolved to a global symbol and the writes/reads hit the wrong storage. } procedure TestRun_NestedProc_CapturesVarArrayParam; + { Two sibling outer routines each declare a same-named nested function. + Each call must resolve to the nested function of its own enclosing + routine. Previously the call fell through to the global overload index + (which does not list nested procs) and errored with "Cannot find + declaration". } + procedure TestRun_NestedProc_SiblingSameName_ResolvesPerScope; + { As above but the enclosing routines are METHODS. Nested-in-method + functions must be scoped to their method body, not registered globally. } + procedure TestRun_NestedFunc_InSiblingMethods_ResolvesPerScope; { Diamond operator: TFoo<> infers type args from LHS } procedure TestRun_Diamond_SingleArg_WorksAtRuntime; @@ -1206,6 +1215,83 @@ begin '5' + LE + '15' + LE + '15' + LE, Output); end; +procedure TE2EMiscTests.TestRun_NestedProc_SiblingSameName_ResolvesPerScope; +const + Src = + ''' + program Prg; + procedure First; + function Helper(X: Integer): Integer; + begin + Result := X + 1 + end; + begin + WriteLn(IntToStr(Helper(10))) + end; + procedure Second; + function Helper(X: Integer): Integer; + begin + Result := X + 2 + end; + begin + WriteLn(IntToStr(Helper(20))) + end; + begin + First(); + Second() + end. + '''; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRun(Src, Output, RCode)); + AssertEquals('exit code 0', 0, RCode); + AssertEquals('First.Helper(10)=11, Second.Helper(20)=22', + '11' + LE + '22' + LE, Output); +end; + +procedure TE2EMiscTests.TestRun_NestedFunc_InSiblingMethods_ResolvesPerScope; +const + Src = + ''' + program Prg; + type + TFoo = class + procedure MethodA; + procedure MethodB; + end; + procedure TFoo.MethodA; + function Helper(X: Integer): Integer; + begin + Result := X + 1 + end; + begin + WriteLn(IntToStr(Helper(10))) + end; + procedure TFoo.MethodB; + function Helper(X: Integer): Integer; + begin + Result := X + 2 + end; + begin + WriteLn(IntToStr(Helper(20))) + end; + var F: TFoo; + begin + F := TFoo.Create; + F.MethodA(); + F.MethodB() + end. + '''; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRun(Src, Output, RCode)); + AssertEquals('exit code 0', 0, RCode); + AssertEquals('MethodA.Helper(10)=11, MethodB.Helper(20)=22', + '11' + LE + '22' + LE, Output); +end; + procedure TE2EMiscTests.TestRun_NestedProc_CapturesVarRecordParam; const Src = diff --git a/compiler/src/test/pascal/cp.test.linker.pas b/compiler/src/test/pascal/cp.test.linker.pas index 303be4d..070df38 100644 --- a/compiler/src/test/pascal/cp.test.linker.pas +++ b/compiler/src/test/pascal/cp.test.linker.pas @@ -1247,7 +1247,7 @@ const 'mremap:' + LineEnding + ' movq $-1, %rax' + LineEnding + { MAP_FAILED — no FreeBSD mremap } ' ret' + LineEnding; - function MovRaxImm4b(AImm: Integer): string; + function MovRaxImm(AImm: Integer): string; begin Result := Chr($48) + Chr($C7) + Chr($C0) + Chr(AImm and $FF) + Chr((AImm shr 8) and $FF) + @@ -1269,10 +1269,10 @@ begin Lk.Free(); end; { getrandom uses the FreeBSD number 563 — NOT Linux's 318. } - AssertTrue('SYS_getrandom=563 movq imm present', Pos(MovRaxImm4b(563), Bytes) >= 0); - AssertTrue('Linux SYS_getrandom=318 NOT present', Pos(MovRaxImm4b(318), Bytes) < 0); + AssertTrue('SYS_getrandom=563 movq imm present', Pos(MovRaxImm(563), Bytes) >= 0); + AssertTrue('Linux SYS_getrandom=318 NOT present', Pos(MovRaxImm(318), Bytes) < 0); { mremap stub loads -1 (movq $-1,%rax = 48 C7 C0 FF FF FF FF). } - AssertTrue('mremap stub returns -1 (MAP_FAILED)', Pos(MovRaxImm4b(-1), Bytes) >= 0); + AssertTrue('mremap stub returns -1 (MAP_FAILED)', Pos(MovRaxImm(-1), Bytes) >= 0); end; procedure TLinkerE2ETests.TestLink_FreeBSDThreadLeaf_SyscallNumbers; @@ -1316,7 +1316,7 @@ const ' syscall' + LineEnding + ' ret' + LineEnding; { Encoded `movq $imm32, %rax` = 48 C7 C0 . } - function MovRaxImm4c(AImm: Integer): string; + function MovRaxImm(AImm: Integer): string; begin Result := Chr($48) + Chr($C7) + Chr($C0) + Chr(AImm and $FF) + Chr((AImm shr 8) and $FF) + @@ -1340,12 +1340,12 @@ begin Lk.Free(); end; { FreeBSD thread syscall NUMBERS present in the linked .text. } - AssertTrue('SYS_thr_new=455 movq imm present', Pos(MovRaxImm4c(455), Bytes) >= 0); - AssertTrue('SYS__umtx_op=454 movq imm present', Pos(MovRaxImm4c(454), Bytes) >= 0); - AssertTrue('SYS_thr_exit=431 movq imm present', Pos(MovRaxImm4c(431), Bytes) >= 0); + AssertTrue('SYS_thr_new=455 movq imm present', Pos(MovRaxImm(455), Bytes) >= 0); + AssertTrue('SYS__umtx_op=454 movq imm present', Pos(MovRaxImm(454), Bytes) >= 0); + AssertTrue('SYS_thr_exit=431 movq imm present', Pos(MovRaxImm(431), Bytes) >= 0); { NOT Linux's clone (56) / futex (202) — those numbers must be absent. } - AssertTrue('Linux SYS_clone=56 NOT present', Pos(MovRaxImm4c(56), Bytes) < 0); - AssertTrue('Linux SYS_futex=202 NOT present', Pos(MovRaxImm4c(202), Bytes) < 0); + AssertTrue('Linux SYS_clone=56 NOT present', Pos(MovRaxImm(56), Bytes) < 0); + AssertTrue('Linux SYS_futex=202 NOT present', Pos(MovRaxImm(202), Bytes) < 0); { _umtx_op's arg4 shuffle: movq %rcx, %r10 (49 89 CA). } AssertTrue('movq %rcx,%r10 (_umtx_op arg4) present', Pos(Chr($49) + Chr($89) + Chr($CA), Bytes) >= 0); diff --git a/compiler/src/test/pascal/cp.test.procs.pas b/compiler/src/test/pascal/cp.test.procs.pas index 770a14d..e8be8e0 100644 --- a/compiler/src/test/pascal/cp.test.procs.pas +++ b/compiler/src/test/pascal/cp.test.procs.pas @@ -72,6 +72,18 @@ type procedure TestCodegen_NestedProc_IsEmittedBeforeOuter; procedure TestCodegen_NestedProc_CapturedVarPassedByPtr; procedure TestCodegen_NestedProc_SameNameInTwoOuters_NoAmbiguity; + { Same as above but the nested routines are FUNCTIONS called as + expressions (Helper(X) inside WriteLn), which exercises + AnalyseFuncCallExpr rather than AnalyseProcCall. The func-call path + previously consulted only the global FProcIndex and errored with + "Cannot find declaration for function 'Helper'". } + procedure TestCodegen_NestedFunc_SameNameInTwoOuters_ResolvesPerScope; + { Two sibling METHOD bodies each declaring a same-named nested function. + Nested-in-method decls were registered in the global overload index + (the registration guard only excluded nested-in-standalone-proc decls), + so they collided as "Ambiguous overload". They must be scoped to their + enclosing method body like nested-in-proc decls. } + procedure TestCodegen_NestedFunc_InTwoMethods_ResolvesPerScope; end; implementation @@ -673,6 +685,87 @@ begin AssertTrue('OuterB_Inner is emitted', StrPos('$OuterB_Inner', IR) >= 0); end; +procedure TProcFuncTests.TestCodegen_NestedFunc_SameNameInTwoOuters_ResolvesPerScope; +const + Src = + ''' + program TwinNestedFunc; + procedure OuterA; + function Helper(X: Integer): Integer; + begin + Result := X + 1; + end; + begin + WriteLn(IntToStr(Helper(10))); + end; + procedure OuterB; + function Helper(X: Integer): Integer; + begin + Result := X + 2; + end; + begin + WriteLn(IntToStr(Helper(20))); + end; + begin + OuterA(); + OuterB(); + end. + '''; +var + IR: string; +begin + IR := GenIR(Src); + { Each sibling nested function is emitted under its own enclosing-routine + qualified label — proving they resolved to distinct decls per scope + rather than colliding as ambiguous overloads. (The call sites may be + inlined, so assert on the emitted function labels, not on a call.) } + AssertTrue('OuterA_Helper is emitted', StrPos('$OuterA_Helper', IR) >= 0); + AssertTrue('OuterB_Helper is emitted', StrPos('$OuterB_Helper', IR) >= 0); +end; + +procedure TProcFuncTests.TestCodegen_NestedFunc_InTwoMethods_ResolvesPerScope; +const + Src = + ''' + program TwinNestedMethod; + type + TFoo = class + procedure MethodA; + procedure MethodB; + end; + procedure TFoo.MethodA; + function Helper(X: Integer): Integer; + begin + Result := X + 1; + end; + begin + WriteLn(IntToStr(Helper(10))); + end; + procedure TFoo.MethodB; + function Helper(X: Integer): Integer; + begin + Result := X + 2; + end; + begin + WriteLn(IntToStr(Helper(20))); + end; + var F: TFoo; + begin + F := TFoo.Create; + F.MethodA(); + F.MethodB(); + end. + '''; +var + IR: string; +begin + IR := GenIR(Src); + { Compiling at all proves the nested-in-method funcs did not collide as + ambiguous overloads; both enclosing methods are emitted. } + AssertTrue('TFoo_MethodA is emitted', StrPos('$TFoo_MethodA', IR) >= 0); + AssertTrue('TFoo_MethodB is emitted', StrPos('$TFoo_MethodB', IR) >= 0); +end; + initialization RegisterTest(TProcFuncTests);