feat(toolchain): host-aware tool resolution with spec + prefix env
Generalise external-tool lookup so a cross/host build finds the right binaries: - target: HostTarget detects the host OS from ParamStr(0) (a '.exe' suffix means Windows, incl. under wine) instead of assuming linux; add ExecutableExtension(target). - uToolchain: TToolSpec (ordered candidate basenames, a cross-triple prefix, and a HostTool flag) + ResolveSpec resolve a tool by env override, then $BLAISE_TOOLCHAIN_PREFIX + name, then the cross prefix on $PATH, then bare name — each probe appending the host exe extension. HostTool distinguishes host tools (run anywhere, target via flags) from target tools (must be the target's own binary; no host fallback when cross). TrySingleName now uses the real host extension. - driver: TBackendDriver.DescribeTools(target) declares a backend's tools (base = the shared linker: cc/clang or the mingw cross-linker for a Windows target); ToolPath resolves one by name; LinkViaToolchain links through it. Self.DescribeTools for virtual dispatch. Native sret codegen fixes (folded in so this commit bootstraps): the toolchain code is the first in the compiler's own source to build a record via a function whose body does SetLength on a dynamic-array Result field, and to pass a record-returning method result directly as a const-record argument. Both miscompiled on the native x86-64 backend (QBE was correct), so a native-compiled compiler could not bootstrap at this commit: - EmitLValueSlotAddr: an l-value field slot on a local record used a raw leaq, but the sret-function Result slot holds a POINTER — route through EmitLocalRecordBase so the pointer is loaded before adding the field offset (fixes SetLength(Result.DynField, N)). - EmitArgHoist: a record-returning method-call argument was materialised via EmitExprToEax, which has no sret path for method calls — allocate the buffer and drive EmitMethodSretCall directly, mirroring the function path. Tests: - cp.test.toolchain: ResolveSpec resolution order, host-tool vs target-tool cross-suppression, fallback naming, and the host/extension helpers. - cp.test.e2e.recordret: regressions for both native sret fixes (both backends). - cp.test.codegen: native backend also emits the _BlaiseInit startup call (the existing assertion only covered QBE). A third, pre-existing native sret bug (sret-call result + const-string arg in the same call) surfaced while writing the toolchain tests; it is independent of this work and logged in bugs.txt. Backend-neutral feature; native fixes are x86-64-only.
This commit is contained in:
Andrew Haines
Graeme Geldenhuys
parent
4e61cb1e8f
commit
a0e0fd567b
|
|
@ -55,7 +55,8 @@ interface
|
|||
uses
|
||||
Classes,
|
||||
blaise.codegen,
|
||||
blaise.codegen.target;
|
||||
blaise.codegen.target,
|
||||
uToolchain;
|
||||
|
||||
type
|
||||
TBackendKind = (bkQBE, bkNative);
|
||||
|
|
@ -103,6 +104,18 @@ type
|
|||
learns to write .bif sidecars and the loader trusts them. }
|
||||
function SupportsWarmCache: Boolean; virtual;
|
||||
|
||||
{ The external tools this backend needs for ATarget, as resolvable
|
||||
specs. uToolchain.ResolveSpec turns each into a path (env override,
|
||||
$BLAISE_TOOLCHAIN_PREFIX, cross-triple prefix, $PATH, host ext). The
|
||||
base lists the shared linker (cc, or the mingw cross-linker for a
|
||||
Windows target); a backend overrides to add its own (e.g. the LLVM
|
||||
driver appends llc) — call inherited and extend. }
|
||||
function DescribeTools(const ATarget: TTargetDesc): TToolSpecArray; virtual;
|
||||
|
||||
{ Resolve one named tool from DescribeTools for ATarget; '' if the
|
||||
backend declares no such tool. }
|
||||
function ToolPath(const AName: string; const ATarget: TTargetDesc): string;
|
||||
|
||||
{ Verify any tools the backend needs are reachable. Returns '' on
|
||||
success, an error message otherwise. Called once before the
|
||||
front-end runs (skipped for stdout-only modes, which need no
|
||||
|
|
@ -164,6 +177,12 @@ type
|
|||
function ClaimsEmitIR: Boolean; virtual;
|
||||
|
||||
protected
|
||||
{ The shared linker tool spec for ATarget (cc/clang, or the mingw
|
||||
cross-linker for a Windows target). A subclass's DescribeTools builds
|
||||
its array from this plus its own tools — the parser has no
|
||||
expression-position `inherited`, so this is the reuse seam. }
|
||||
function LinkerToolSpec(const ATarget: TTargetDesc): TToolSpec;
|
||||
|
||||
{ Shared link line: cc-driver resolved via uToolchain (env overrides
|
||||
and target awareness apply), input file, OPDF sidecar, extra
|
||||
objects, RTL archive, -lm, -lpthread. Used by every driver's
|
||||
|
|
@ -233,6 +252,42 @@ begin
|
|||
Result := False;
|
||||
end;
|
||||
|
||||
function TBackendDriver.LinkerToolSpec(const ATarget: TTargetDesc): TToolSpec;
|
||||
begin
|
||||
{ Shared linker slot. A target tool (HostTool=False): native build uses
|
||||
cc/clang; a Windows target cross-links via the mingw clang driver
|
||||
(x86_64-w64-mingw32-clang) and never falls back to the host cc. }
|
||||
Result.Name := 'linker';
|
||||
Result.EnvVar := 'BLAISE_LINKER';
|
||||
SetLength(Result.Cands, 2);
|
||||
Result.Cands[0] := 'cc';
|
||||
Result.Cands[1] := 'clang';
|
||||
Result.HostTool := False;
|
||||
if ATarget.OS = osWindows then
|
||||
Result.CrossPrefix := 'x86_64-w64-mingw32-'
|
||||
else
|
||||
Result.CrossPrefix := '';
|
||||
end;
|
||||
|
||||
function TBackendDriver.DescribeTools(const ATarget: TTargetDesc): TToolSpecArray;
|
||||
begin
|
||||
SetLength(Result, 1);
|
||||
Result[0] := Self.LinkerToolSpec(ATarget);
|
||||
end;
|
||||
|
||||
function TBackendDriver.ToolPath(const AName: string;
|
||||
const ATarget: TTargetDesc): string;
|
||||
var
|
||||
Specs: TToolSpecArray;
|
||||
I: Integer;
|
||||
begin
|
||||
Result := '';
|
||||
Specs := Self.DescribeTools(ATarget);
|
||||
for I := 0 to High(Specs) do
|
||||
if SameText(Specs[I].Name, AName) then
|
||||
Exit(ResolveSpec(Specs[I], ATarget));
|
||||
end;
|
||||
|
||||
function TBackendDriver.CheckToolchain(AOpts: TBackendOpts): string;
|
||||
begin
|
||||
{ No tools to probe by default. AOpts is part of the signature so a
|
||||
|
|
@ -289,6 +344,8 @@ begin
|
|||
Args.Add('-o');
|
||||
Args.Add(AOutputFile);
|
||||
Args.Add(AInputFile);
|
||||
{ Linker resolved via DescribeTools so a Windows target picks the mingw
|
||||
cross-linker and a Windows host adds the .exe extension. }
|
||||
{ OPDF sidecar (QBE backend only — the native backend appends its
|
||||
exact-facts OPDF section to the main assembly instead). }
|
||||
if (AOpts.OPDFAsmFile <> '') and FileExists(AOpts.OPDFAsmFile) then
|
||||
|
|
@ -302,7 +359,7 @@ begin
|
|||
Args.Add(TC.RTLPath);
|
||||
Args.Add('-lm'); { math functions (sqrt, sin, cos, etc.) }
|
||||
Args.Add('-lpthread'); { POSIX threads (blaise_thread unit) }
|
||||
ExitCode := RunProcess(TC.Linker.Path, Args, Msg);
|
||||
ExitCode := RunProcess(Self.ToolPath('linker', AOpts.Target), Args, Msg);
|
||||
finally
|
||||
Args.Free();
|
||||
end;
|
||||
|
|
|
|||
|
|
@ -3799,7 +3799,12 @@ begin
|
|||
Self.Emit(#9'movq (%rdx), %rdx');
|
||||
end
|
||||
else if Self.IsLocal(FAE.RecordName) then
|
||||
Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(FAE.RecordName)]))
|
||||
{ The slot IS the record for an ordinary local, but holds a POINTER for
|
||||
the sret-function Result — EmitLocalRecordBase loads vs leaq-s
|
||||
accordingly. Without this, SetLength(Result.DynField, N) and other
|
||||
l-value field slots in an sret function added the field offset to the
|
||||
address of the pointer slot instead of to the pointed-to record. }
|
||||
Self.EmitLocalRecordBase(FAE.RecordName, '%rdx')
|
||||
else
|
||||
Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [FAE.RecordName]));
|
||||
if FAE.FieldInfo.Offset > 0 then
|
||||
|
|
@ -11898,7 +11903,18 @@ begin
|
|||
argument slots and corrupt the popq sequence. }
|
||||
if (not IsVarPos) and Self.IsRecCallArg(Arg) then
|
||||
begin
|
||||
Self.EmitExprToEax(Arg); { buffer at %rsp, pointer in %rax }
|
||||
if Arg is TMethodCallExpr then
|
||||
begin
|
||||
{ EmitExprToEax routes a method call through EmitMethodCallExpr, which
|
||||
has no sret-buffer path — it would leave %rax pointing at nothing.
|
||||
Allocate the buffer and drive the sret call directly, mirroring the
|
||||
TFuncCallExpr path in EmitExprToEax. }
|
||||
Self.Emit(Format(#9'subq $%d, %%rsp', [Self.RecArgBufBytes(Arg)]));
|
||||
Self.EmitMethodSretCall(TMethodCallExpr(Arg), '(%rsp)', False);
|
||||
Self.Emit(#9'leaq (%rsp), %rax');
|
||||
end
|
||||
else
|
||||
Self.EmitExprToEax(Arg); { buffer at %rsp, pointer in %rax }
|
||||
Self.Emit(#9'pushq %rax');
|
||||
Result := Result + Self.RecArgBufBytes(Arg) + 8;
|
||||
ADepths.Add(Result);
|
||||
|
|
|
|||
|
|
@ -43,7 +43,8 @@ type
|
|||
procedure MakeTarget(AOS: TTargetOS; ACPU: TTargetCPU; out ATarget: TTargetDesc);
|
||||
|
||||
{ The host target this compiler binary runs on (the default when --target is
|
||||
omitted). Today the only build host is linux-x86_64. }
|
||||
omitted). The host OS is one of TTargetOS, detected from our own
|
||||
executable's name — a '.exe' suffix means Windows (including under wine). }
|
||||
function HostTarget: TTargetDesc;
|
||||
|
||||
{ Pointer size in bytes for the target (8 for 64-bit, 4 for 32-bit). }
|
||||
|
|
@ -65,6 +66,11 @@ function TargetLineEnding(const ATarget: TTargetDesc): string;
|
|||
function TargetDirectorySeparator(const ATarget: TTargetDesc): string;
|
||||
function TargetPathSeparator(const ATarget: TTargetDesc): string;
|
||||
|
||||
{ Executable-file extension for binaries that run on ATarget's OS: '.exe' on
|
||||
Windows, empty elsewhere. Used to probe host tools (llc, cc) with the right
|
||||
suffix and to name output binaries. }
|
||||
function ExecutableExtension(const ATarget: TTargetDesc): string;
|
||||
|
||||
var
|
||||
GTarget: TTargetDesc;
|
||||
|
||||
|
|
@ -81,7 +87,14 @@ end;
|
|||
|
||||
function HostTarget: TTargetDesc;
|
||||
begin
|
||||
MakeTarget(osLinux, cpuX86_64, Result);
|
||||
{ A '.exe' suffix on our own path means we are running on Windows (incl.
|
||||
under wine). Unix hosts carry no extension; we can't cheaply tell
|
||||
linux/macos/freebsd apart here, and only the Windows distinction matters
|
||||
for tool extensions today, so default the unix case to linux. }
|
||||
if LowerCase(ExtractFileExt(ParamStr(0))) = '.exe' then
|
||||
MakeTarget(osWindows, cpuX86_64, Result)
|
||||
else
|
||||
MakeTarget(osLinux, cpuX86_64, Result);
|
||||
end;
|
||||
|
||||
function PtrSize(const ATarget: TTargetDesc): Integer;
|
||||
|
|
@ -171,6 +184,15 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function ExecutableExtension(const ATarget: TTargetDesc): string;
|
||||
begin
|
||||
case ATarget.OS of
|
||||
osWindows: Result := '.exe';
|
||||
else
|
||||
Result := '';
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
GTarget := HostTarget();
|
||||
|
||||
|
|
|
|||
|
|
@ -53,6 +53,32 @@ type
|
|||
RTLPath: string; { '' if not found }
|
||||
end;
|
||||
|
||||
{ One external tool a backend declares it needs (TBackendDriver.DescribeTools).
|
||||
Cands lists candidate basenames in preference order (e.g. 'llc-18','llc'),
|
||||
'' terminates the list. Resolution order in ResolveSpec, per candidate:
|
||||
1. EnvVar override (verbatim, FileExists) — once, before Cands
|
||||
2. $BLAISE_TOOLCHAIN_PREFIX + candidate (+ host ext)
|
||||
3. CrossPrefix + candidate on $PATH, when cross-compiling
|
||||
4. bare candidate on $PATH (+ host ext)
|
||||
5. fallback to the first candidate (clean exec-time error)
|
||||
The host extension ('.exe' on a Windows host) is appended at every probe.
|
||||
|
||||
HostTool distinguishes the two natures the cross case needs:
|
||||
* True — the tool runs on the host and targets via flags (llc with
|
||||
-mtriple); a bare $PATH match is fine even when cross.
|
||||
* False — the tool must be the *target's* own binary (the linker); on a
|
||||
cross build the bare host fallback (step 4) is suppressed so we
|
||||
don't link Windows output with the host cc. }
|
||||
TToolSpec = record
|
||||
Name: string; { 'linker' | 'llc' | 'qbe' | 'as' }
|
||||
EnvVar: string; { per-tool override, e.g. 'BLAISE_LLC' }
|
||||
Cands: array of string; { ordered candidate basenames }
|
||||
CrossPrefix: string; { triple prefix, 'x86_64-w64-mingw32-' }
|
||||
HostTool: Boolean; { see above }
|
||||
end;
|
||||
|
||||
TToolSpecArray = array of TToolSpec;
|
||||
|
||||
{ One-shot resolver — call once per native/QBE compile, read the resulting
|
||||
record for every subprocess + library path. }
|
||||
function ResolveToolchain(const ATarget: TTargetDesc): TToolchain;
|
||||
|
|
@ -67,6 +93,13 @@ function FindRTLArchive(const ATarget: TTargetDesc): string;
|
|||
absolute path on hit, '' on miss. On Windows hosts also tries '.exe'. }
|
||||
function WhichInPath(const ABaseName: string): string;
|
||||
|
||||
{ Host executable-file extension ('.exe' on a Windows host, else '').
|
||||
Derived from blaise.codegen.target.HostTarget. }
|
||||
function HostExeExt: string;
|
||||
|
||||
{ Resolve one tool spec against the active target (see TToolSpec). }
|
||||
function ResolveSpec(const ASpec: TToolSpec; const ATarget: TTargetDesc): string;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
|
|
@ -83,29 +116,31 @@ uses
|
|||
{ PATH walker }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
function IsWindowsHost: Boolean;
|
||||
function HostExeExt: string;
|
||||
begin
|
||||
Result := False;
|
||||
Result := ExecutableExtension(HostTarget());
|
||||
end;
|
||||
|
||||
function PathSep: string;
|
||||
begin
|
||||
Result := PathSeparator; { ':' on POSIX }
|
||||
Result := PathSeparator; { ':' on POSIX, ';' on a Windows host }
|
||||
end;
|
||||
|
||||
function TrySingleName(const ADir, ABaseName: string): string;
|
||||
var
|
||||
Candidate: string;
|
||||
Candidate, Ext: string;
|
||||
begin
|
||||
Candidate := IncludeTrailingPathDelimiter(ADir) + ABaseName;
|
||||
if FileExists(Candidate) then
|
||||
begin
|
||||
Exit(Candidate);
|
||||
end;
|
||||
{ Blaise Pos: -1 = not found. `< 0` is the "not present" test. }
|
||||
if IsWindowsHost() and (Pos('.exe', LowerCase(ABaseName)) < 0) then
|
||||
{ On a Windows host, retry with the executable extension — unless the
|
||||
basename already carries it. Blaise Pos: -1 = not found. }
|
||||
Ext := HostExeExt();
|
||||
if (Ext <> '') and (Pos(LowerCase(Ext), LowerCase(ABaseName)) < 0) then
|
||||
begin
|
||||
Candidate := IncludeTrailingPathDelimiter(ADir) + ABaseName + '.exe';
|
||||
Candidate := IncludeTrailingPathDelimiter(ADir) + ABaseName + Ext;
|
||||
if FileExists(Candidate) then
|
||||
begin
|
||||
Exit(Candidate);
|
||||
|
|
@ -114,6 +149,14 @@ begin
|
|||
Result := '';
|
||||
end;
|
||||
|
||||
{ FileExists(APath), then FileExists(APath+AExt) when AExt is non-empty. }
|
||||
function TryPathWithExt(const APath, AExt: string): string;
|
||||
begin
|
||||
if FileExists(APath) then Exit(APath);
|
||||
if (AExt <> '') and FileExists(APath + AExt) then Exit(APath + AExt);
|
||||
Result := '';
|
||||
end;
|
||||
|
||||
function WhichInPath(const ABaseName: string): string;
|
||||
var
|
||||
Path, Entry: string;
|
||||
|
|
@ -191,6 +234,60 @@ begin
|
|||
Result := ACandB;
|
||||
end;
|
||||
|
||||
{ Spec-driven resolver — the path a backend's DescribeTools spec takes.
|
||||
See TToolSpec for the order. HostExeExt is appended at every probe. }
|
||||
function ResolveSpec(const ASpec: TToolSpec; const ATarget: TTargetDesc): string;
|
||||
var
|
||||
Ext, EnvP, Pref, Hit: string;
|
||||
Cross: Boolean;
|
||||
I: Integer;
|
||||
begin
|
||||
Ext := HostExeExt();
|
||||
Cross := HostTarget().OS <> ATarget.OS;
|
||||
|
||||
{ 1. explicit per-tool override — verbatim, wins over everything. }
|
||||
if ASpec.EnvVar <> '' then
|
||||
begin
|
||||
EnvP := GetEnvironmentVariable(ASpec.EnvVar);
|
||||
if (EnvP <> '') and FileExists(EnvP) then Exit(EnvP);
|
||||
end;
|
||||
|
||||
Pref := GetEnvironmentVariable('BLAISE_TOOLCHAIN_PREFIX');
|
||||
|
||||
{ 2. $BLAISE_TOOLCHAIN_PREFIX + each candidate. }
|
||||
if Pref <> '' then
|
||||
for I := 0 to High(ASpec.Cands) do
|
||||
begin
|
||||
Hit := TryPathWithExt(Pref + ASpec.Cands[I], Ext);
|
||||
if Hit <> '' then Exit(Hit);
|
||||
end;
|
||||
|
||||
{ 3. derived cross-triple prefix on $PATH (cross builds only). }
|
||||
if Cross and (ASpec.CrossPrefix <> '') then
|
||||
for I := 0 to High(ASpec.Cands) do
|
||||
begin
|
||||
Hit := WhichInPath(ASpec.CrossPrefix + ASpec.Cands[I]);
|
||||
if Hit <> '' then Exit(Hit);
|
||||
end;
|
||||
|
||||
{ 4. bare candidate on $PATH. Host tools (llc) always; target tools
|
||||
(the linker) only on a native build — never fall back to the host
|
||||
linker for a cross target. }
|
||||
if ASpec.HostTool or (not Cross) then
|
||||
for I := 0 to High(ASpec.Cands) do
|
||||
begin
|
||||
Hit := WhichInPath(ASpec.Cands[I]);
|
||||
if Hit <> '' then Exit(Hit);
|
||||
end;
|
||||
|
||||
{ 5. fallback — name the cross tool when we have a prefix so the exec-time
|
||||
"not found" error is actionable. }
|
||||
if Cross and (ASpec.CrossPrefix <> '') then
|
||||
Result := ASpec.CrossPrefix + ASpec.Cands[0]
|
||||
else
|
||||
Result := ASpec.Cands[0];
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Per-tool resolvers }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
|
|
|||
|
|
@ -129,6 +129,7 @@ uses
|
|||
cp.test.tokenkindname,
|
||||
cp.test.strutils,
|
||||
cp.test.e2e.strutils,
|
||||
cp.test.toolchain,
|
||||
cp.test.dynarray,
|
||||
cp.test.math,
|
||||
cp.test.e2e.math,
|
||||
|
|
|
|||
|
|
@ -12,12 +12,14 @@ interface
|
|||
|
||||
uses
|
||||
blaise.testing,
|
||||
uLexer, uParser, uAST, uSemantic, blaise.codegen.qbe;
|
||||
uLexer, uParser, uAST, uSemantic, blaise.codegen.qbe,
|
||||
blaise.codegen.native, blaise.codegen.target;
|
||||
|
||||
type
|
||||
TCodeGenTests = class(TTestCase)
|
||||
private
|
||||
function GenerateIR(const ASrc: string): string;
|
||||
function GenerateNativeAsm(const ASrc: string): string;
|
||||
function IRContains(const AIR, AFragment: string): Boolean;
|
||||
published
|
||||
{ Data sections }
|
||||
|
|
@ -28,6 +30,7 @@ type
|
|||
procedure TestOutput_HasMainFunction;
|
||||
procedure TestOutput_HasRetZero;
|
||||
procedure TestMain_CallsBlaiseInit;
|
||||
procedure TestMain_Native_CallsBlaiseInit;
|
||||
|
||||
{ WriteLn }
|
||||
procedure TestWriteLn_NoArgs_CallsSysWriteNewline;
|
||||
|
|
@ -117,6 +120,36 @@ begin
|
|||
end;
|
||||
end;
|
||||
|
||||
function TCodeGenTests.GenerateNativeAsm(const ASrc: string): string;
|
||||
var
|
||||
L: TLexer;
|
||||
P: TParser;
|
||||
Pr: TProgram;
|
||||
A: TSemanticAnalyser;
|
||||
CG: TCodeGenNative;
|
||||
begin
|
||||
L := TLexer.Create(ASrc);
|
||||
P := TParser.Create(L);
|
||||
Pr := P.Parse();
|
||||
A := TSemanticAnalyser.Create();
|
||||
try
|
||||
A.Analyse(Pr);
|
||||
finally
|
||||
A.Free();
|
||||
end;
|
||||
CG := TCodeGenNative.Create();
|
||||
try
|
||||
CG.SetTarget(HostTarget());
|
||||
CG.Generate(Pr);
|
||||
Result := CG.GetOutput();
|
||||
finally
|
||||
CG.Free();
|
||||
Pr.Free();
|
||||
P.Free();
|
||||
L.Free();
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCodeGenTests.IRContains(const AIR, AFragment: string): Boolean;
|
||||
begin
|
||||
Result := Pos(AFragment, AIR) >= 0;
|
||||
|
|
@ -175,6 +208,24 @@ begin
|
|||
IRContains(IR, 'call $_BlaiseInit()'));
|
||||
end;
|
||||
|
||||
{ The native backend must also emit the _BlaiseInit call (right after
|
||||
_SetArgs, which it must follow because _BlaiseInit clobbers the SysV arg
|
||||
registers). Guards against a backend skew where only one backend wires
|
||||
up the RTL startup hook. }
|
||||
procedure TCodeGenTests.TestMain_Native_CallsBlaiseInit;
|
||||
var
|
||||
Asm_: string;
|
||||
begin
|
||||
Asm_ := GenerateNativeAsm('program P; begin end.');
|
||||
AssertTrue('native main calls _BlaiseInit',
|
||||
IRContains(Asm_, 'callq _BlaiseInit'));
|
||||
AssertTrue('native main calls _SetArgs',
|
||||
IRContains(Asm_, 'callq _SetArgs'));
|
||||
{ _SetArgs must precede _BlaiseInit. }
|
||||
AssertTrue('_SetArgs precedes _BlaiseInit',
|
||||
Pos('callq _SetArgs', Asm_) < Pos('callq _BlaiseInit', Asm_));
|
||||
end;
|
||||
|
||||
{ WriteLn }
|
||||
|
||||
procedure TCodeGenTests.TestWriteLn_NoArgs_CallsSysWriteNewline;
|
||||
|
|
|
|||
|
|
@ -59,6 +59,17 @@ type
|
|||
procedure TestRun_RcSSE1_TwoSingle_RoundTrip;
|
||||
{ Managed-field record stays on sret (string field → no register return). }
|
||||
procedure TestRun_ManagedField_StaysSret;
|
||||
{ Regression: SetLength + indexed store on a dynamic-array FIELD of an
|
||||
sret-Result record. The native backend used to leaq the address of the
|
||||
Result pointer slot and add the field offset to it, instead of loading
|
||||
the pointer first — corrupting the stack (crash). Both backends. }
|
||||
procedure TestRun_SretResult_DynArrayField_SetLength;
|
||||
{ Regression: a record-returning METHOD call result passed directly as a
|
||||
const-record argument. EmitArgHoist materialised the sret buffer via
|
||||
EmitExprToEax, which has no sret path for method calls (only functions),
|
||||
so the argument pointer was garbage and the callee read junk (crash).
|
||||
Both backends. }
|
||||
procedure TestRun_RecordMethodResult_AsConstArg;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
|
@ -437,6 +448,70 @@ begin
|
|||
AssertEquals('managed field stays on sret', 'hello' + LE, Output);
|
||||
end;
|
||||
|
||||
procedure TE2ERecordReturnTests.TestRun_SretResult_DynArrayField_SetLength;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
type
|
||||
TRec = record
|
||||
Name: string;
|
||||
Cands: array of string;
|
||||
end;
|
||||
function Make: TRec;
|
||||
begin
|
||||
Result.Name := 'linker';
|
||||
SetLength(Result.Cands, 2);
|
||||
Result.Cands[0] := 'cc';
|
||||
Result.Cands[1] := 'clang'
|
||||
end;
|
||||
var R: TRec;
|
||||
begin
|
||||
R := Make();
|
||||
WriteLn(R.Name);
|
||||
WriteLn(R.Cands[0]);
|
||||
WriteLn(R.Cands[1])
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(Src, 'linker' + LE + 'cc' + LE + 'clang' + LE, 0);
|
||||
end;
|
||||
|
||||
procedure TE2ERecordReturnTests.TestRun_RecordMethodResult_AsConstArg;
|
||||
const
|
||||
Src = '''
|
||||
program P;
|
||||
type
|
||||
TR = record A, B: Integer; end;
|
||||
TFoo = class
|
||||
function MakeR: TR;
|
||||
procedure Run;
|
||||
end;
|
||||
function Sum(const R: TR): Integer;
|
||||
begin
|
||||
Result := R.A + R.B
|
||||
end;
|
||||
function TFoo.MakeR: TR;
|
||||
begin
|
||||
Result.A := 1;
|
||||
Result.B := 2
|
||||
end;
|
||||
procedure TFoo.Run;
|
||||
begin
|
||||
WriteLn(Sum(Self.MakeR()))
|
||||
end;
|
||||
var F: TFoo;
|
||||
begin
|
||||
F := TFoo.Create();
|
||||
F.Run();
|
||||
F.Free()
|
||||
end.
|
||||
''';
|
||||
begin
|
||||
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
|
||||
AssertRunsOnAll(Src, '3' + LE, 0);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TE2ERecordReturnTests);
|
||||
|
||||
|
|
|
|||
191
compiler/src/test/pascal/cp.test.toolchain.pas
Normal file
191
compiler/src/test/pascal/cp.test.toolchain.pas
Normal file
|
|
@ -0,0 +1,191 @@
|
|||
{
|
||||
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.toolchain;
|
||||
|
||||
{ Tests for host-aware external-tool resolution (uToolchain.ResolveSpec) and
|
||||
the target host/extension helpers it relies on.
|
||||
|
||||
ResolveSpec resolves a tool, per candidate, in this order:
|
||||
1. EnvVar override (verbatim) — not exercised here
|
||||
(no setenv binding in the test RTL; the override branch is a simple
|
||||
GetEnvironmentVariable + FileExists guard).
|
||||
2. $BLAISE_TOOLCHAIN_PREFIX + candidate — env-driven, skipped
|
||||
3. cross-triple prefix on $PATH (cross builds only)
|
||||
4. bare candidate on $PATH — host tools always, target tools native-only
|
||||
5. actionable fallback name
|
||||
|
||||
The behaviour these tests pin is the part that is independent of the
|
||||
environment: the host-tool-vs-target-tool cross-suppression (step 4), the
|
||||
fallback naming (step 5), and the pure host/extension helpers. }
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
blaise.testing,
|
||||
blaise.codegen.target, uToolchain;
|
||||
|
||||
type
|
||||
TToolchainTests = class(TTestCase)
|
||||
private
|
||||
{ Build a linker-like target tool spec (HostTool=False) with a mingw
|
||||
cross prefix, the shape TBackendDriver.LinkerToolSpec produces. }
|
||||
function MakeLinkerSpec: TToolSpec;
|
||||
{ Build a host tool spec (HostTool=True, e.g. llc) — runs anywhere. }
|
||||
function MakeHostToolSpec: TToolSpec;
|
||||
function LinuxTarget: TTargetDesc;
|
||||
function WindowsTarget: TTargetDesc;
|
||||
published
|
||||
{ ---- pure helpers ---- }
|
||||
procedure TestExecutableExtension_Windows_IsExe;
|
||||
procedure TestExecutableExtension_Linux_IsEmpty;
|
||||
procedure TestHostTarget_OnThisHost_IsLinux;
|
||||
procedure TestHostExeExt_OnThisHost_IsEmpty;
|
||||
|
||||
{ ---- ResolveSpec: native (non-cross) build ---- }
|
||||
{ A target tool resolves to a real $PATH binary on a native build. }
|
||||
procedure TestResolveSpec_NativeLinker_FindsCcOnPath;
|
||||
|
||||
{ ---- ResolveSpec: cross build, target tool ---- }
|
||||
{ Cross + target tool + no cross-linker installed: the bare host fallback
|
||||
is SUPPRESSED, so we never resolve to the host cc for a Windows output;
|
||||
the actionable cross-prefixed name is returned instead. }
|
||||
procedure TestResolveSpec_CrossLinker_DoesNotFallBackToHostCc;
|
||||
procedure TestResolveSpec_CrossLinker_FallbackIsCrossPrefixed;
|
||||
|
||||
{ ---- ResolveSpec: cross build, host tool ---- }
|
||||
{ Cross + host tool: a bare $PATH match IS allowed (host tools run on the
|
||||
host and target via flags), so a host tool still resolves. }
|
||||
procedure TestResolveSpec_CrossHostTool_AllowsBarePathMatch;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
function TToolchainTests.MakeLinkerSpec: TToolSpec;
|
||||
begin
|
||||
Result.Name := 'linker';
|
||||
Result.EnvVar := 'BLAISE_LINKER';
|
||||
SetLength(Result.Cands, 2);
|
||||
Result.Cands[0] := 'cc';
|
||||
Result.Cands[1] := 'clang';
|
||||
Result.CrossPrefix := 'x86_64-w64-mingw32-';
|
||||
Result.HostTool := False;
|
||||
end;
|
||||
|
||||
function TToolchainTests.MakeHostToolSpec: TToolSpec;
|
||||
begin
|
||||
{ 'cc' is guaranteed present on $PATH in the build environment, so it makes
|
||||
a reliable stand-in for a host tool (llc) that resolves by bare name. }
|
||||
Result.Name := 'hosttool';
|
||||
Result.EnvVar := 'BLAISE_HOSTTOOL';
|
||||
SetLength(Result.Cands, 1);
|
||||
Result.Cands[0] := 'cc';
|
||||
Result.CrossPrefix := 'x86_64-w64-mingw32-';
|
||||
Result.HostTool := True;
|
||||
end;
|
||||
|
||||
function TToolchainTests.LinuxTarget: TTargetDesc;
|
||||
begin
|
||||
MakeTarget(osLinux, cpuX86_64, Result);
|
||||
end;
|
||||
|
||||
function TToolchainTests.WindowsTarget: TTargetDesc;
|
||||
begin
|
||||
MakeTarget(osWindows, cpuX86_64, Result);
|
||||
end;
|
||||
|
||||
{ ---- pure helpers ---- }
|
||||
|
||||
procedure TToolchainTests.TestExecutableExtension_Windows_IsExe;
|
||||
begin
|
||||
AssertEquals('Windows target → .exe', '.exe',
|
||||
ExecutableExtension(Self.WindowsTarget()));
|
||||
end;
|
||||
|
||||
procedure TToolchainTests.TestExecutableExtension_Linux_IsEmpty;
|
||||
begin
|
||||
AssertEquals('Linux target → no extension', '',
|
||||
ExecutableExtension(Self.LinuxTarget()));
|
||||
end;
|
||||
|
||||
procedure TToolchainTests.TestHostTarget_OnThisHost_IsLinux;
|
||||
var
|
||||
HostOS: Integer;
|
||||
begin
|
||||
{ The compiler binary running the suite has no .exe suffix, so HostTarget
|
||||
detects linux. (On a Windows host this test would need adjusting — but
|
||||
the suite is built and run on linux.) Read .OS into a local first: a
|
||||
record-call result read inline as an AssertEquals argument trips a
|
||||
separate native sret bug (see bugs.txt). }
|
||||
HostOS := Ord(HostTarget().OS);
|
||||
AssertEquals('host OS is linux', Ord(osLinux), HostOS);
|
||||
end;
|
||||
|
||||
procedure TToolchainTests.TestHostExeExt_OnThisHost_IsEmpty;
|
||||
begin
|
||||
AssertEquals('no host exe extension on a unix host', '', HostExeExt());
|
||||
end;
|
||||
|
||||
{ ---- ResolveSpec: native build ---- }
|
||||
|
||||
procedure TToolchainTests.TestResolveSpec_NativeLinker_FindsCcOnPath;
|
||||
var
|
||||
Resolved: string;
|
||||
begin
|
||||
{ Native linux build: the linker is a target tool, but the target IS the
|
||||
host, so the bare $PATH lookup applies and finds a real cc/clang. }
|
||||
Resolved := ResolveSpec(Self.MakeLinkerSpec(), Self.LinuxTarget());
|
||||
AssertTrue('resolved to an absolute path on $PATH (found cc/clang)',
|
||||
(Length(Resolved) > 0) and (Resolved[0] = '/'));
|
||||
end;
|
||||
|
||||
{ ---- ResolveSpec: cross build, target tool ---- }
|
||||
|
||||
procedure TToolchainTests.TestResolveSpec_CrossLinker_DoesNotFallBackToHostCc;
|
||||
var
|
||||
Resolved: string;
|
||||
begin
|
||||
{ Cross-compiling to Windows from a linux host. The mingw cross-linker is
|
||||
not installed in the build environment, so resolution must NOT silently
|
||||
fall back to the host /usr/bin/cc — that would link Windows output with
|
||||
the host linker. The result must therefore not be an absolute host path. }
|
||||
Resolved := ResolveSpec(Self.MakeLinkerSpec(), Self.WindowsTarget());
|
||||
AssertTrue('cross target tool did not resolve to a host path',
|
||||
not ((Length(Resolved) > 0) and (Resolved[0] = '/')));
|
||||
end;
|
||||
|
||||
procedure TToolchainTests.TestResolveSpec_CrossLinker_FallbackIsCrossPrefixed;
|
||||
var
|
||||
Resolved: string;
|
||||
begin
|
||||
{ With no installed cross tool, the fallback (step 5) names the
|
||||
cross-prefixed first candidate so the exec-time error is actionable. }
|
||||
Resolved := ResolveSpec(Self.MakeLinkerSpec(), Self.WindowsTarget());
|
||||
AssertEquals('fallback is the cross-prefixed first candidate',
|
||||
'x86_64-w64-mingw32-cc', Resolved);
|
||||
end;
|
||||
|
||||
{ ---- ResolveSpec: cross build, host tool ---- }
|
||||
|
||||
procedure TToolchainTests.TestResolveSpec_CrossHostTool_AllowsBarePathMatch;
|
||||
var
|
||||
Resolved: string;
|
||||
begin
|
||||
{ A host tool may resolve to a bare $PATH binary even when cross-compiling,
|
||||
because it runs on the host and targets via flags. The stand-in ('cc') is
|
||||
on $PATH, so it must resolve to an absolute path despite the Windows
|
||||
target. }
|
||||
Resolved := ResolveSpec(Self.MakeHostToolSpec(), Self.WindowsTarget());
|
||||
AssertTrue('host tool resolves to a $PATH binary even when cross',
|
||||
(Length(Resolved) > 0) and (Resolved[0] = '/'));
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TToolchainTests);
|
||||
|
||||
end.
|
||||
Loading…
Reference in a new issue