From ed262aa2380160be04e59de7e6af3973f6cbdca3 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 25 Jun 2026 14:39:44 +0100 Subject: [PATCH] fix(driver): write per-unit .o/.bif to CWD, not root, for a bare --output In default incremental mode each used unit is compiled to its own .o/.bif by a worker thread. The worker's output directory was derived as IncludeTrailingPathDelimiter(ExtractFilePath(OutputFile)). When --output is a bare filename with no directory part (e.g. `--output mcd`), ExtractFilePath returns '' and IncludeTrailingPathDelimiter('') yields '/', so the worker tried to write `/.o.bif.tmp` at the filesystem root and aborted with `Worker exception: Cannot open file for writing: /.o.bif.tmp`. Resolve the artefact directory once before the worker loop, treating an empty directory (bare or omitted --output, no --unit-cache) as the current directory instead of root. Priority is unchanged: --unit-cache, then the --output directory, then CWD. Add a CLI regression test that compiles a program using a separate unit with a bare --output name and asserts no root-path worker failure and a clean exit. --- compiler/src/main/pascal/Blaise.pas | 26 +++++++---- compiler/src/test/pascal/cp.test.cli.pas | 55 ++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 9 deletions(-) diff --git a/compiler/src/main/pascal/Blaise.pas b/compiler/src/main/pascal/Blaise.pas index 40d42b5..64f6c9f 100644 --- a/compiler/src/main/pascal/Blaise.pas +++ b/compiler/src/main/pascal/Blaise.pas @@ -498,6 +498,7 @@ var IRFile: string; LinkErr: string; { Driver.LinkProgram result ('' on success) } UnitOPath: string; { per-dep .o output path in incremental mode } + UnitODir: string; { directory the per-dep .o/.bif files are written to } Workers: TObjectList; { TCompileWorker threads for parallel incremental } Worker: TCompileWorker; @@ -825,17 +826,24 @@ begin WorkerDriver := GetDriver(bkQBE); Workers := TObjectList.Create(True); try + { Resolve the directory the per-unit .o/.bif artefacts go in. + Priority: an explicit --unit-cache, else the --output file's own + directory. When neither yields a directory (e.g. --output is a + bare filename with no path component, or omitted entirely) the + artefacts are written to the current directory — never to the + filesystem root. ExtractFilePath returns '' for a path with no + directory part; IncludeTrailingPathDelimiter('') would turn that + into '/', anchoring the unit objects at root, so only prepend a + delimiter when the directory is non-empty. } + if UnitCacheDir <> '' then + UnitODir := IncludeTrailingPathDelimiter(UnitCacheDir) + else if ExtractFilePath(OutputFile) <> '' then + UnitODir := IncludeTrailingPathDelimiter(ExtractFilePath(OutputFile)) + else + UnitODir := ''; for I := 0 to Units.Count - 1 do begin - UnitOPath := UnitCacheDir; - if UnitOPath <> '' then - UnitOPath := IncludeTrailingPathDelimiter(UnitOPath) + - LowerCase(TUnit(Units.Items[I]).Name) + '.o' - else if OutputFile <> '' then - UnitOPath := IncludeTrailingPathDelimiter(ExtractFilePath(OutputFile)) + - LowerCase(TUnit(Units.Items[I]).Name) + '.o' - else - UnitOPath := LowerCase(TUnit(Units.Items[I]).Name) + '.o'; + UnitOPath := UnitODir + LowerCase(TUnit(Units.Items[I]).Name) + '.o'; Worker := TCompileWorker.Create(True); Worker.WorkUnit := TUnit(Units.Items[I]); diff --git a/compiler/src/test/pascal/cp.test.cli.pas b/compiler/src/test/pascal/cp.test.cli.pas index 7c0a1ae..4aa8197 100644 --- a/compiler/src/test/pascal/cp.test.cli.pas +++ b/compiler/src/test/pascal/cp.test.cli.pas @@ -81,6 +81,9 @@ type procedure TestDivByZeroCaught_Native; procedure TestModByZeroCaught_QBE; procedure TestModByZeroCaught_Native; + { ---- a bare --output (no directory part) must not anchor per-unit + .o/.bif artefacts at the filesystem root ---- } + procedure TestBareOutput_UnitArtefacts_NotWrittenToRoot; end; implementation @@ -559,6 +562,58 @@ begin AssertTrue('mod by zero caught', Pos('mod caught', Out_) >= 0); end; +procedure TCLIContractTests.TestBareOutput_UnitArtefacts_NotWrittenToRoot; +var + UnitPath, ProgPath, Out_: string; + EC: Integer; +begin + if not CompilerAvailable() then begin Ignore(''); Exit; end; + { Regression: incremental compilation (default) compiles each used unit to + its own .o/.bif via a worker. The worker's output directory was derived + from --output via IncludeTrailingPathDelimiter(ExtractFilePath(OutputFile)). + For a bare --output filename (no directory part) ExtractFilePath returns '' + and IncludeTrailingPathDelimiter('') yields '/', so the worker tried to + write '/.o.bif.tmp' at the filesystem root and failed with + 'Cannot open file for writing: /.o.bif.tmp'. The artefacts must land + in the current directory instead. } + UnitPath := FScratch + 'clidemo_unit.pas'; + WriteFile(UnitPath, + 'unit clidemo_unit;' + LineEnding + + 'interface' + LineEnding + + 'function Answer: Integer;' + LineEnding + + 'implementation' + LineEnding + + 'function Answer: Integer;' + LineEnding + + 'begin' + LineEnding + + ' Result := 42' + LineEnding + + 'end;' + LineEnding + + 'end.'); + ProgPath := WriteScratchSource( + 'program cli_bareout;' + LineEnding + + 'uses clidemo_unit;' + LineEnding + + 'begin' + LineEnding + + ' WriteLn(Answer())' + LineEnding + + 'end.'); + { Bare --output name (no '/') is the trigger; the unit is found via the + scratch --unit-path. } + EC := RunCompiler([ + '--source', ProgPath, + '--unit-path', FScratch, + '--unit-path', FRTLPath, + '--unit-path', FStdlibPath, + '--output', 'cli_bareout_bin' + ], Out_); + { The bare output name resolves relative to the compiler's CWD (the test + runner's working directory): the program binary and the per-unit .o land + there. Remove them so the working tree stays clean. } + if FileExists('cli_bareout_bin') then DeleteFile('cli_bareout_bin'); + if FileExists('clidemo_unit.o') then DeleteFile('clidemo_unit.o'); + AssertTrue('no root-path worker failure: ' + Out_, + Pos('Cannot open file for writing: /', Out_) < 0); + AssertTrue('no worker exception: ' + Out_, + Pos('Worker exception', Out_) < 0); + AssertEquals('bare --output compile exits 0: ' + Out_, 0, EC); +end; + { ---- Registration ---- } initialization