diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index dddd957..6ad4bf5 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -3663,7 +3663,15 @@ begin Self.EmitLoadVar(Self.VarOperand('Result'), ADecl.ResolvedReturnType); end; { Release ARC-managed local string vars (not params, not Result). - Result is returned to the caller who owns it; params are caller-owned. } + Result is returned to the caller who owns it; params are caller-owned. + + TODO(arc): the native backend does not yet retain string/class *value* + params on entry and release them on exit (the QBE backend does — see the + entry/exit ARC loops in uCodeGenQBE.pas). When that retain/release is + added here, it MUST skip params where P.IsConstParam is True (as well as + IsVarParam / IsOpenArray): a const param's object is kept alive by the + caller for the whole call, so no callee-side retain/release is needed. + See the matching `or Par.IsConstParam` guards in uCodeGenQBE.pas. } if ADecl.Body <> nil then begin for I := 0 to ADecl.Body.Decls.Count - 1 do diff --git a/compiler/src/main/pascal/uCodeGenQBE.pas b/compiler/src/main/pascal/uCodeGenQBE.pas index 7cd5cf4..0189757 100644 --- a/compiler/src/main/pascal/uCodeGenQBE.pas +++ b/compiler/src/main/pascal/uCodeGenQBE.pas @@ -5258,11 +5258,13 @@ begin EmitParamAllocs(AMethod, nil); { ARC: addref string and class value params on entry — balances the - release pass at method exit. } + release pass at method exit. const params are skipped: the caller + guarantees the object stays alive for the whole call, so the callee + needs no retain/release. } for I := 0 to AMethod.Params.Count - 1 do begin Par := TMethodParam(AMethod.Params.Items[I]); - if Par.IsVarParam or Par.IsOpenArray then Continue; + if Par.IsVarParam or Par.IsOpenArray or Par.IsConstParam then Continue; if Par.ResolvedType.Kind = tyString then begin ValTemp := AllocTemp; @@ -5313,11 +5315,12 @@ begin FExitLabel := SavedExitLbl; end; - { ARC: release string and class value params on exit. } + { ARC: release string and class value params on exit. const params are + skipped to match the entry pass (no retain was taken). } for I := 0 to AMethod.Params.Count - 1 do begin Par := TMethodParam(AMethod.Params.Items[I]); - if Par.IsVarParam or Par.IsOpenArray then Continue; + if Par.IsVarParam or Par.IsOpenArray or Par.IsConstParam then Continue; if Par.ResolvedType.Kind = tyString then begin ValTemp := AllocTemp; @@ -6088,11 +6091,13 @@ begin end; { ARC: addref string and class value params on entry (callee owns a - retained copy that is balanced by the release pass at function exit). } + retained copy that is balanced by the release pass at function exit). + const params are skipped: the caller keeps the object alive for the + whole call, so no retain/release is needed. } for I := 0 to ADecl.Params.Count - 1 do begin Par := TMethodParam(ADecl.Params.Items[I]); - if Par.IsVarParam or Par.IsOpenArray then Continue; + if Par.IsVarParam or Par.IsOpenArray or Par.IsConstParam then Continue; if Par.ResolvedType.Kind = tyString then begin ValTemp := AllocTemp; @@ -6149,11 +6154,12 @@ begin end; { ARC: release string and class value params on exit (balances the - addref inserted at function entry). } + addref inserted at function entry). const params are skipped to match + the entry pass (no retain was taken). } for I := 0 to ADecl.Params.Count - 1 do begin Par := TMethodParam(ADecl.Params.Items[I]); - if Par.IsVarParam or Par.IsOpenArray then Continue; + if Par.IsVarParam or Par.IsOpenArray or Par.IsConstParam then Continue; if Par.ResolvedType.Kind = tyString then begin ValTemp := AllocTemp; diff --git a/compiler/src/test/pascal/cp.test.arc.pas b/compiler/src/test/pascal/cp.test.arc.pas index 4efacf1..9579897 100644 --- a/compiler/src/test/pascal/cp.test.arc.pas +++ b/compiler/src/test/pascal/cp.test.arc.pas @@ -48,6 +48,10 @@ type procedure TestARC_StringVarParam_NoAddRef; procedure TestARC_StringVarParam_NoRelease; + { String const parameter: no addref, no release (caller holds it alive) } + procedure TestARC_StringConstParam_NoAddRef; + procedure TestARC_StringConstParam_NoRelease; + { String concatenation: calls RTL concat function } procedure TestARC_StringConcat_SemanticOK; procedure TestARC_StringConcat_CallsRTL; @@ -290,6 +294,14 @@ const begin end. '''; + SrcConstParam = + ''' + program P; + procedure Greet(const S: string); + begin end; + begin end. + '''; + SrcConcat = ''' program P; @@ -331,6 +343,22 @@ begin AssertFalse('no release for string var param', IRContains(IR, 'call $_StringRelease')); end; +procedure TARCTests.TestARC_StringConstParam_NoAddRef; +var + IR: string; +begin + IR := GenIR(SrcConstParam); + AssertFalse('no addref for string const param', IRContains(IR, 'call $_StringAddRef')); +end; + +procedure TARCTests.TestARC_StringConstParam_NoRelease; +var + IR: string; +begin + IR := GenIR(SrcConstParam); + AssertFalse('no release for string const param', IRContains(IR, 'call $_StringRelease')); +end; + procedure TARCTests.TestARC_StringConcat_SemanticOK; var L: TLexer; diff --git a/compiler/src/test/pascal/cp.test.e2e.arc.pas b/compiler/src/test/pascal/cp.test.e2e.arc.pas index 0575eed..26d59de 100644 --- a/compiler/src/test/pascal/cp.test.e2e.arc.pas +++ b/compiler/src/test/pascal/cp.test.e2e.arc.pas @@ -27,6 +27,7 @@ type procedure TestRun_WeakRef_BreaksCycle_Valgrind; procedure TestRun_ClassDestroy_FreesBuffer_Valgrind; procedure TestRun_TListARC_Valgrind; + procedure TestRun_ConstParam_NoRetainRelease_Valgrind; { Three instantiations of the same generic class: verifies the Pointer→class ARC coercion bug is fixed (the 3rd instantiation no longer uses freed memory). } procedure TestRun_ThreeGenericInstances_AllWork; @@ -314,6 +315,49 @@ const end. '''; +const + { const class/string params: the codegen elides the callee-side + _ClassAddRef/_ClassRelease and _StringAddRef/_StringRelease pair because + the caller keeps the argument alive for the whole call. This program + passes both a class instance and a string as const and uses them inside + the callee; valgrind must report no leak and no use-after-free, proving + the elision is balanced (no over-release, no missing retain). } + SrcConstParamNoRetain = ''' + program P; + type + TThing = class + FValue: Integer; + end; + procedure Show(const T: TThing; const S: string); + begin + WriteLn(S); + WriteLn(T.FValue) + end; + var + A: TThing; + begin + A := TThing.Create; + A.FValue := 99; + Show(A, 'hello') + end. + '''; + +procedure TE2EArcTests.TestRun_ConstParam_NoRetainRelease_Valgrind; +var Output: string; RCode: Integer; Log: string; OK: Boolean; +begin + if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRun(SrcConstParamNoRetain, Output, RCode)); + AssertEquals('exit 0', 0, RCode); + AssertEquals('stdout', 'hello' + LE + '99' + LE, Output); + if not ValgrindAvailable then begin Ignore('valgrind not installed'); Exit; end; + OK := RunUnderValgrind(SrcConstParamNoRetain, Log); + if not OK then + begin + if Log = '' then Log := '(valgrind produced no output)'; + Fail('const-param ARC elision unbalanced — valgrind reports:' + LE + Log); + end; +end; + procedure TE2EArcTests.TestRun_ThreeGenericInstances_AllWork; var Output: string; RCode: Integer; begin