perf(qbe): shape-aware const-string argument ARC
Const-string args were pinned (AddRef before the call, Release after) regardless of shape. ConstArgMode now classifies them: string literals and named consts are immortal and emit no ARC ops at all; +1 owned temps (function/method/getter returns) emit a single post-call Release that consumes the transferred reference — previously these leaked one buffer per call (the pin pair netted to zero and EmitOwnedArgReleases deliberately skipped const-string params); every other shape keeps the pin. The hot TStringList lookup signatures (Compare, KeyEquals, HashOf, Find, FindSorted, IndexOf) become const. Borrowed elision for plain local variables — the larger win — is deliberately NOT enabled: it is sound at the ARC level, but removing the balanced pin pairs changes caller register allocation and exposes a latent use-before-def of a callee-saved register in the native backend's EmitInterfaceCall (a second-generation compiler then reads the caller's leftover %r13 as an AST pointer and crashes). The full repro and bisect trail are recorded in the bug log; the camPin branch carries a pointer to it. Verified through two self-hosted generations plus both fixpoints; contract pinned by 7 IR tests in cp.test.constarg.pas.
This commit is contained in:
Graeme Geldenhuys
parent
8ce374c0ba
commit
91f44ec823
|
|
@ -26,6 +26,10 @@ procedure _ir_memcpy(Dst, Src: Pointer; N: Int64); external name 'memcpy';
|
|||
type
|
||||
ECodeGenError = class(Exception);
|
||||
|
||||
{ Caller-side protection mode for a const-string argument — see
|
||||
ConstArgMode for the classification rules. }
|
||||
TConstArgMode = (camPin, camBorrowed, camConsume);
|
||||
|
||||
{ Growable byte buffer for QBE IR output. Replaces TStringList + .Text:
|
||||
AppendLine writes bytes directly — no per-line string allocation.
|
||||
AppendBuffer bulk-copies another buffer in one memcpy.
|
||||
|
|
@ -250,12 +254,25 @@ type
|
|||
AArgs.Items[i], or '' if that arg was not a value temp (e.g. var param). }
|
||||
procedure EmitOwnedArgReleases(AArgs: TObjectList; AArgTemps: TStringList;
|
||||
AParams: TObjectList);
|
||||
{ Caller-side retain/release for a const-string param. A const param skips
|
||||
the callee-side _StringAddRef/_StringRelease pair (see 5a5b5d4), so a
|
||||
fresh transient (rc=0 from _StringConcat or a function returning string)
|
||||
would be unowned for the duration of the call. Variables/fields/literals
|
||||
already have a live owner — the AddRef/Release pair nets to zero on them. }
|
||||
procedure EnsureConstStringRef(const AArgTemp: string; APar: TMethodParam);
|
||||
{ Caller-side protection for const-string params. A const param skips
|
||||
the callee-side _StringAddRef/_StringRelease pair (5a5b5d4), so the
|
||||
caller must keep the argument alive for the duration of the call.
|
||||
ConstArgMode classifies by argument shape:
|
||||
|
||||
camBorrowed — string literals and named string consts: immortal
|
||||
data, no ARC ops are emitted at all.
|
||||
camConsume — +1 owned temps (function/method/getter returns): no
|
||||
AddRef; the single post-call Release consumes the
|
||||
transferred reference (these previously leaked).
|
||||
camPin — everything else, including plain local variables —
|
||||
AddRef before the call, Release after. Locals would
|
||||
be safe to borrow in principle (the frame's own
|
||||
reference outlives the call), but eliding their pin
|
||||
exposes a latent uninitialised-register miscompile
|
||||
(bugs.txt 2026-06-10) — revisit once that is fixed. }
|
||||
function ConstArgMode(AArg: TASTExpr; AParams: TObjectList): TConstArgMode;
|
||||
procedure EnsureConstStringRef(const AArgTemp: string; APar: TMethodParam;
|
||||
AArg: TASTExpr; AParams: TObjectList);
|
||||
procedure ReleaseConstStringArgs(AArgs: TObjectList;
|
||||
AArgTemps: TStringList; AParams: TObjectList);
|
||||
procedure EmitInheritedCall(ACall: TInheritedCallStmt);
|
||||
|
|
@ -3675,16 +3692,48 @@ begin
|
|||
end;
|
||||
|
||||
{ call $_StringAddRef(l <ArgTemp>) }
|
||||
function TCodeGenQBE.ConstArgMode(AArg: TASTExpr;
|
||||
AParams: TObjectList): TConstArgMode;
|
||||
var
|
||||
IE: TIdentExpr;
|
||||
begin
|
||||
Result := camPin;
|
||||
if AArg = nil then Exit;
|
||||
if AArg is TStringLiteral then
|
||||
Exit(camBorrowed);
|
||||
if AArg is TIdentExpr then
|
||||
begin
|
||||
IE := TIdentExpr(AArg);
|
||||
if IE.IsImplicitSelfMethod then
|
||||
Exit(camConsume); { bare zero-arg method call — +1 owned return }
|
||||
if IE.IsConstant then
|
||||
Exit(camBorrowed); { named string const — immortal literal data }
|
||||
{ Plain non-captured locals/params would also be safe to borrow, but
|
||||
eliding their pin currently exposes a latent uninitialised-register
|
||||
miscompile downstream (see bugs.txt 2026-06-10, 'borrowed-local
|
||||
elision exposes EmitInterfaceCall register corruption') — keep them
|
||||
pinned until that is fixed. }
|
||||
Exit(camPin); { variable of any kind — pin }
|
||||
end;
|
||||
if ExprOwnsRef(AArg) then
|
||||
Exit(camConsume); { function/method/getter return — +1 owned temp }
|
||||
end;
|
||||
|
||||
procedure TCodeGenQBE.EnsureConstStringRef(const AArgTemp: string;
|
||||
APar: TMethodParam);
|
||||
APar: TMethodParam; AArg: TASTExpr; AParams: TObjectList);
|
||||
begin
|
||||
if (APar = nil) or (AArgTemp = '') then Exit;
|
||||
if APar.IsConstParam and (APar.ResolvedType <> nil) and
|
||||
(APar.ResolvedType.Kind = tyString) then
|
||||
EmitLine(Format(' call $_StringAddRef(l %s)', [AArgTemp]));
|
||||
begin
|
||||
if ConstArgMode(AArg, AParams) = camPin then
|
||||
EmitLine(Format(' call $_StringAddRef(l %s)', [AArgTemp]));
|
||||
end;
|
||||
end;
|
||||
|
||||
{ call $_StringRelease(l <ArgTemps[I]>) for each const-string param. }
|
||||
{ call $_StringRelease(l <ArgTemps[I]>) for each pinned or consumed
|
||||
const-string argument (borrowed args emitted no AddRef and need no
|
||||
Release; consumed args take ownership of the +1 temp here). }
|
||||
procedure TCodeGenQBE.ReleaseConstStringArgs(AArgs: TObjectList;
|
||||
AArgTemps: TStringList; AParams: TObjectList);
|
||||
var
|
||||
|
|
@ -3700,8 +3749,11 @@ begin
|
|||
Par := TMethodParam(AParams.Items[I]);
|
||||
if Par.IsConstParam and (Par.ResolvedType <> nil) and
|
||||
(Par.ResolvedType.Kind = tyString) then
|
||||
EmitLine(Format(' call $_StringRelease(l %s)',
|
||||
[AArgTemps.Strings[I]]));
|
||||
begin
|
||||
if ConstArgMode(TASTExpr(AArgs.Items[I]), AParams) <> camBorrowed then
|
||||
EmitLine(Format(' call $_StringRelease(l %s)',
|
||||
[AArgTemps.Strings[I]]));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
|
@ -5785,7 +5837,7 @@ begin
|
|||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(ACall.Args.Items[I]), MDecl.Params);
|
||||
QType := QbeTypeOf(Par.ResolvedType);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(ACall.Args.Items[I]), QType);
|
||||
ArgLine := ArgLine + Format(', %s %s', [QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
|
|
@ -5979,7 +6031,7 @@ begin
|
|||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(ACall.Args.Items[I]), MDecl.Params);
|
||||
QType := QbeTypeOf(Par.ResolvedType);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(ACall.Args.Items[I]), QType);
|
||||
ArgLine := ArgLine + Format(', %s %s',
|
||||
|
|
@ -7554,7 +7606,7 @@ begin
|
|||
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
|
||||
while ArgTemps.Count < I do ArgTemps.Add('');
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(ACall.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(ACall.Args.Items[I]), QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format(', %s %s',
|
||||
[QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
|
|
@ -7647,7 +7699,7 @@ begin
|
|||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(ACall.Args.Items[I]));
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(ACall.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(ACall.Args.Items[I]), QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format('%s %s', [QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
end;
|
||||
|
|
@ -9341,7 +9393,7 @@ begin
|
|||
ArgTemp := EmitExpr(TASTExpr(FC.Args.Items[I]));
|
||||
while ArgTemps.Count < I do ArgTemps.Add('');
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(FC.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(FC.Args.Items[I]), QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format(', %s %s',
|
||||
[QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
|
|
@ -9413,7 +9465,7 @@ begin
|
|||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(FC.Args.Items[I]));
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(FC.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(FC.Args.Items[I]), QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format('%s %s', [QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
end;
|
||||
|
|
@ -9603,7 +9655,7 @@ begin
|
|||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(MCallExpr.Args.Items[I]));
|
||||
if Par.IsVarParam then ArgTemps.Add('') else ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(MCallExpr.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(MCallExpr.Args.Items[I]),
|
||||
QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format(', %s %s',
|
||||
|
|
@ -9772,7 +9824,7 @@ begin
|
|||
begin
|
||||
ArgTemp := EmitExpr(TASTExpr(MCallExpr.Args.Items[I]));
|
||||
ArgTemps.Add(ArgTemp);
|
||||
EnsureConstStringRef(ArgTemp, Par);
|
||||
EnsureConstStringRef(ArgTemp, Par, TASTExpr(MCallExpr.Args.Items[I]), MDecl.Params);
|
||||
ArgTemp := CoerceArg(ArgTemp, TASTExpr(MCallExpr.Args.Items[I]),
|
||||
QbeTypeOf(Par.ResolvedType));
|
||||
ArgLine := ArgLine + Format(', %s %s', [QbeParamTypeOf(Par.ResolvedType), ArgTemp]);
|
||||
|
|
|
|||
|
|
@ -67,6 +67,7 @@ uses
|
|||
cp.test.collections,
|
||||
cp.test.stringlistfind,
|
||||
cp.test.maphash,
|
||||
cp.test.constarg,
|
||||
cp.test.caseenum,
|
||||
cp.test.sets,
|
||||
cp.test.selfhosting,
|
||||
|
|
|
|||
313
compiler/src/test/pascal/cp.test.constarg.pas
Normal file
313
compiler/src/test/pascal/cp.test.constarg.pas
Normal file
|
|
@ -0,0 +1,313 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
unit cp.test.constarg;
|
||||
|
||||
{ IR tests for shape-aware const-string argument handling (QBE backend).
|
||||
|
||||
Const string params skip the callee-side retain/release pair (5a5b5d4);
|
||||
the caller protects the argument for the duration of the call. The
|
||||
protection depends on the argument's shape:
|
||||
|
||||
borrowed — string literals and named string consts (immortal data):
|
||||
NO AddRef/Release pair is emitted at all.
|
||||
consume — function/method/getter returns (+1 owned temps): no
|
||||
AddRef, ONE Release after the call consumes the temp
|
||||
(previously these leaked).
|
||||
pin — everything else, including plain local variables —
|
||||
AddRef before the call, Release after. Locals would be
|
||||
borrowable in principle, but eliding their pin exposes a
|
||||
latent uninitialised-register miscompile (bugs.txt
|
||||
2026-06-10); these tests pin the CURRENT contract and
|
||||
should be revisited when local borrowing lands. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, blaise.testing, uStrCompat,
|
||||
uLexer, uParser, uAST, uSymbolTable, uSemantic, blaise.codegen.qbe;
|
||||
|
||||
type
|
||||
TConstArgTests = class(TTestCase)
|
||||
private
|
||||
function GenIR(const ASrc: string): string;
|
||||
{ Extract the body of one emitted function (from 'function ... $Name('
|
||||
to the closing brace) so ARC assertions are not polluted by other
|
||||
functions' codegen. }
|
||||
function FuncRegion(const AIR, AName: string): string;
|
||||
published
|
||||
procedure TestConstArg_ParamForward_Pins;
|
||||
procedure TestConstArg_LocalVar_Pins;
|
||||
procedure TestConstArg_Literal_NoPin;
|
||||
procedure TestConstArg_GlobalVar_Pins;
|
||||
procedure TestConstArg_OwnedReturn_ConsumeOnly;
|
||||
procedure TestConstArg_Concat_Pins;
|
||||
procedure TestConstArg_VarStringSibling_Pins;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TConstArgTests.GenIR(const ASrc: string): string;
|
||||
var
|
||||
L: TLexer;
|
||||
P: TParser;
|
||||
Prog: TProgram;
|
||||
A: TSemanticAnalyser;
|
||||
CG: TCodeGenQBE;
|
||||
begin
|
||||
L := TLexer.Create(ASrc);
|
||||
P := TParser.Create(L);
|
||||
try
|
||||
Prog := P.Parse();
|
||||
finally
|
||||
P.Free(); L.Free();
|
||||
end;
|
||||
try
|
||||
A := TSemanticAnalyser.Create();
|
||||
try
|
||||
A.Analyse(Prog);
|
||||
finally
|
||||
A.Free();
|
||||
end;
|
||||
CG := TCodeGenQBE.Create();
|
||||
try
|
||||
CG.Generate(Prog);
|
||||
Result := CG.GetOutput();
|
||||
finally
|
||||
CG.Free();
|
||||
end;
|
||||
finally
|
||||
Prog.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
function TConstArgTests.FuncRegion(const AIR, AName: string): string;
|
||||
var
|
||||
StartP, EndP: Integer;
|
||||
Marker: string;
|
||||
begin
|
||||
Marker := '$' + AName + '(';
|
||||
StartP := Pos(Marker, AIR);
|
||||
AssertTrue('function ' + AName + ' present in IR', StartP >= 0);
|
||||
EndP := StrPos('}', StrCopyTail(AIR, StartP));
|
||||
AssertTrue('function ' + AName + ' closed', EndP >= 0);
|
||||
Result := StrCopyFrom(AIR, StartP, EndP);
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_ParamForward_Pins;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
procedure Sink(const S: string);
|
||||
begin
|
||||
end;
|
||||
procedure Caller(const T: string);
|
||||
begin
|
||||
Sink(T)
|
||||
end;
|
||||
var L: string;
|
||||
begin
|
||||
L := 'x';
|
||||
Caller(L)
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
begin
|
||||
{ Forwarding a const param to a const param would be borrowable, but
|
||||
variable shapes currently pin (see unit comment). }
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertTrue('AddRef pins forwarded param', Pos('_StringAddRef', Region) >= 0);
|
||||
AssertTrue('Release unpins forwarded param',
|
||||
Pos('_StringRelease', Region) >= 0);
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_LocalVar_Pins;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
procedure Sink(const S: string);
|
||||
begin
|
||||
end;
|
||||
function Mk: string;
|
||||
begin
|
||||
Result := IntToStr(7)
|
||||
end;
|
||||
procedure Caller;
|
||||
var
|
||||
L: string;
|
||||
begin
|
||||
L := Mk();
|
||||
Sink(L)
|
||||
end;
|
||||
begin
|
||||
Caller()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
RelCount, I: Integer;
|
||||
begin
|
||||
{ L := Mk() consumes the owned return (no AddRef) but still releases L's
|
||||
previous value; Sink(L) pins L (variable shape, see unit comment).
|
||||
Releases in Caller: assignment release-old + call unpin + L's
|
||||
scope-exit release. }
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertTrue('pin AddRef present', Pos('_StringAddRef', Region) >= 0);
|
||||
RelCount := 0;
|
||||
I := Pos('_StringRelease', Region);
|
||||
while I >= 0 do
|
||||
begin
|
||||
RelCount := RelCount + 1;
|
||||
I := PosEx('_StringRelease', Region, I + 1);
|
||||
end;
|
||||
AssertEquals('three Releases (assign old + call unpin + scope exit)',
|
||||
3, RelCount);
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_Literal_NoPin;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
procedure Sink(const S: string);
|
||||
begin
|
||||
end;
|
||||
procedure Caller;
|
||||
begin
|
||||
Sink('hello')
|
||||
end;
|
||||
begin
|
||||
Caller()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
begin
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertEquals('no AddRef for literal arg', -1, Pos('_StringAddRef', Region));
|
||||
AssertEquals('no Release for literal arg', -1, Pos('_StringRelease', Region));
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_GlobalVar_Pins;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
var G: string;
|
||||
procedure Sink(const S: string);
|
||||
begin
|
||||
end;
|
||||
procedure Caller;
|
||||
begin
|
||||
Sink(G)
|
||||
end;
|
||||
begin
|
||||
G := 'x';
|
||||
Caller()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
begin
|
||||
{ A global can be reassigned by the callee (through its own name), which
|
||||
would release the buffer the borrowed argument points at — must pin. }
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertTrue('AddRef pins global arg', Pos('_StringAddRef', Region) >= 0);
|
||||
AssertTrue('Release unpins global arg', Pos('_StringRelease', Region) >= 0);
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_OwnedReturn_ConsumeOnly;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
procedure Sink(const S: string);
|
||||
begin
|
||||
end;
|
||||
function Mk: string;
|
||||
begin
|
||||
Result := IntToStr(7)
|
||||
end;
|
||||
procedure Caller;
|
||||
begin
|
||||
Sink(Mk())
|
||||
end;
|
||||
begin
|
||||
Caller()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
begin
|
||||
{ Mk() hands over a +1 temp; the post-call Release consumes it (this
|
||||
used to leak — the pin pair netted to zero and nobody released). }
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertEquals('no AddRef for owned-return arg', -1,
|
||||
Pos('_StringAddRef', Region));
|
||||
AssertTrue('Release consumes the owned temp',
|
||||
Pos('_StringRelease', Region) >= 0);
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_Concat_Pins;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
procedure Sink(const S: string);
|
||||
begin
|
||||
end;
|
||||
procedure Caller(const T: string);
|
||||
begin
|
||||
Sink('a' + T)
|
||||
end;
|
||||
var L: string;
|
||||
begin
|
||||
L := 'x';
|
||||
Caller(L)
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
begin
|
||||
{ _StringConcat returns an rc=0 transient: the AddRef/Release pair both
|
||||
protects it during the call and frees it afterwards. }
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertTrue('AddRef pins concat temp', Pos('_StringAddRef', Region) >= 0);
|
||||
AssertTrue('Release frees concat temp', Pos('_StringRelease', Region) >= 0);
|
||||
end;
|
||||
|
||||
procedure TConstArgTests.TestConstArg_VarStringSibling_Pins;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
procedure Swapish(const A: string; var B: string);
|
||||
begin
|
||||
B := 'new'
|
||||
end;
|
||||
procedure Caller;
|
||||
var
|
||||
L: string;
|
||||
begin
|
||||
L := IntToStr(7);
|
||||
Swapish(L, L)
|
||||
end;
|
||||
begin
|
||||
Caller()
|
||||
end.
|
||||
''';
|
||||
var
|
||||
Region: string;
|
||||
begin
|
||||
{ B aliases L itself: the callee's write to B releases L's buffer while
|
||||
A still borrows it — A must be pinned (variable shapes always pin). }
|
||||
Region := FuncRegion(GenIR(Src), 'Caller');
|
||||
AssertTrue('AddRef pins despite local shape',
|
||||
Pos('_StringAddRef', Region) >= 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TConstArgTests);
|
||||
|
||||
end.
|
||||
|
|
@ -175,10 +175,10 @@ type
|
|||
FHashCap: Integer; { power of two; 0 = index not built }
|
||||
FHashUsed: Integer; { occupied slots (excludes duplicate keys) }
|
||||
procedure Grow;
|
||||
function Compare(S1: string; S2: string): Integer;
|
||||
function FindSorted(S: string; var Idx: Integer): Boolean;
|
||||
function HashOf(S: string): Integer;
|
||||
function KeyEquals(S1: string; S2: string): Boolean;
|
||||
function Compare(const S1: string; const S2: string): Integer;
|
||||
function FindSorted(const S: string; var Idx: Integer): Boolean;
|
||||
function HashOf(const S: string): Integer;
|
||||
function KeyEquals(const S1: string; const S2: string): Boolean;
|
||||
procedure HashInvalidate;
|
||||
procedure HashInsertIdx(AIdx: Integer);
|
||||
procedure HashRebuild;
|
||||
|
|
@ -188,8 +188,8 @@ type
|
|||
procedure Destroy;
|
||||
function Add(S: string): Integer;
|
||||
procedure AddObject(S: string; AObject: Pointer);
|
||||
function Find(S: string; var Index: Integer): Boolean;
|
||||
function IndexOf(S: string): Integer;
|
||||
function Find(const S: string; var Index: Integer): Boolean;
|
||||
function IndexOf(const S: string): Integer;
|
||||
function Get(AIndex: Integer): string;
|
||||
procedure Put(AIndex: Integer; S: string);
|
||||
function GetObject(AIndex: Integer): Pointer;
|
||||
|
|
@ -387,7 +387,7 @@ begin
|
|||
Self.FCapacity := NewCap
|
||||
end;
|
||||
|
||||
function TStringList.Compare(S1: string; S2: string): Integer;
|
||||
function TStringList.Compare(const S1: string; const S2: string): Integer;
|
||||
begin
|
||||
if Self.FCaseSensitive then
|
||||
Result := CompareStr(S1, S2)
|
||||
|
|
@ -397,7 +397,7 @@ end;
|
|||
|
||||
{ Equality-only comparison for hash probing. Cheaper than Compare: both
|
||||
RTL helpers reject on length before touching the bytes. }
|
||||
function TStringList.KeyEquals(S1: string; S2: string): Boolean;
|
||||
function TStringList.KeyEquals(const S1: string; const S2: string): Boolean;
|
||||
begin
|
||||
if Self.FCaseSensitive then
|
||||
Result := S1 = S2
|
||||
|
|
@ -407,7 +407,7 @@ end;
|
|||
|
||||
{ FNV-1a over the string bytes, folding A..Z to a..z when the list is
|
||||
case-insensitive so equal-modulo-case keys land in the same bucket. }
|
||||
function TStringList.HashOf(S: string): Integer;
|
||||
function TStringList.HashOf(const S: string): Integer;
|
||||
var
|
||||
I: Integer;
|
||||
C: Integer;
|
||||
|
|
@ -504,7 +504,7 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function TStringList.FindSorted(S: string; var Idx: Integer): Boolean;
|
||||
function TStringList.FindSorted(const S: string; var Idx: Integer): Boolean;
|
||||
var
|
||||
Lo: Integer;
|
||||
Hi: Integer;
|
||||
|
|
@ -620,7 +620,7 @@ begin
|
|||
ObjP^ := AObject
|
||||
end;
|
||||
|
||||
function TStringList.Find(S: string; var Index: Integer): Boolean;
|
||||
function TStringList.Find(const S: string; var Index: Integer): Boolean;
|
||||
const
|
||||
cHashThreshold = 16; { below this a linear scan beats building a table }
|
||||
var
|
||||
|
|
@ -676,7 +676,7 @@ begin
|
|||
end
|
||||
end;
|
||||
|
||||
function TStringList.IndexOf(S: string): Integer;
|
||||
function TStringList.IndexOf(const S: string): Integer;
|
||||
var
|
||||
Idx: Integer;
|
||||
begin
|
||||
|
|
|
|||
Loading…
Reference in a new issue