From 87c17ee5895673ea0012db2fa3244ae34b953e4a Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 18 Jun 2026 18:23:12 +0100 Subject: [PATCH] fix(native): suppress duplicate built-in system defs in unit-to-.o compilation MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Compiling a unit to a standalone .o with the native backend (blaise --source U.pas --output U.o) emitted the built-in system definitions — typeinfo_/vtable_/_FieldCleanup_ for TObject and TCustomAttribute — into the unit .o. Linking that .o against a consumer program (which emits its own copies) failed with 'multiple definition of vtable_TCustomAttribute'. Two gaps fed this: - The unit-as-top-level path in Blaise.pas built its codegen via Driver.CreateCodeGen (the program path, separate-compile = False) instead of Driver.CreateUnitCodeGen (separate-compile = True), so the backend's FSeparateCompile gate (which already suppresses the system defs) never engaged. Switched the IsUnitMode branch to CreateUnitCodeGen, with a CreateCodeGen fallback for any backend lacking a unit codegen. - TCodeGenNative.GenerateUnit did not propagate FSeparateCompile to the backend (AppendUnit already did); added the missing propagation for defensive correctness. The QBE backend was unaffected (its unit path already suppresses these). Adds TestNativeBackend_RoundTrip_NoDuplicateSystemDefs in cp.test.e2e.sepcompile, which pins --backend native so the guard holds regardless of the compiler's default backend. --- compiler/src/main/pascal/Blaise.pas | 13 +++- .../src/main/pascal/blaise.codegen.native.pas | 7 ++ .../test/pascal/cp.test.e2e.sepcompile.pas | 71 +++++++++++++++++++ 3 files changed, 90 insertions(+), 1 deletion(-) diff --git a/compiler/src/main/pascal/Blaise.pas b/compiler/src/main/pascal/Blaise.pas index abc61b0..f6cb67f 100644 --- a/compiler/src/main/pascal/Blaise.pas +++ b/compiler/src/main/pascal/Blaise.pas @@ -812,7 +812,18 @@ begin QBE for fixpoint / RTL Makefile compatibility; --emit-asm implies native); the per-backend construction details — class to instantiate, knobs to wire — live behind Driver.CreateCodeGen. } - CG := Driver.CreateCodeGen(Opts); + { Unit-as-top-level uses the UNIT codegen so the per-unit .o suppresses + the built-in system defs (typeinfo_/vtable_/_FieldCleanup_ for TObject + and TCustomAttribute); CreateCodeGen (the program path) would emit them + and the .o would then collide with the consumer program at link + ("multiple definition of vtable_TCustomAttribute"). Falls back to + CreateCodeGen for a backend that does not provide a unit codegen. } + if IsUnitMode then + CG := Driver.CreateUnitCodeGen(Opts) + else + CG := Driver.CreateCodeGen(Opts); + if CG = nil then + CG := Driver.CreateCodeGen(Opts); if IsUnitMode then begin { Unit-as-top-level: emit just the unit's bodies, no program wrapping, no @main. } diff --git a/compiler/src/main/pascal/blaise.codegen.native.pas b/compiler/src/main/pascal/blaise.codegen.native.pas index ee4fd9f..c6e2719 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.pas @@ -166,6 +166,13 @@ begin Self.EnsureBackend(); FBackend.SetSymbolTable(FSymTable); FBackend.SetDebugMode(FDebugMode); + { Propagate separate-compile so the per-unit .o suppresses the built-in + system defs (typeinfo_/vtable_/_FieldCleanup_ for TObject and + TCustomAttribute). Without this the unit .o redefines them and the link + against the consumer program fails with "multiple definition of + vtable_TCustomAttribute". AppendUnit already does this; GenerateUnit (the + --output .o path) was missing it. } + FBackend.SetSeparateCompile(FSeparateCompile); FBackend.SetDebugFacts(FDbgFacts); FOutput := FBackend.GenerateUnit(AUnit); end; diff --git a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas index dc1ae1a..aacaabc 100644 --- a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas +++ b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas @@ -44,6 +44,7 @@ type function RunBinary(const AExe: string; out AStdout: string): Integer; published procedure TestFreeRoutine_RoundTrip_WithoutSource; + procedure TestNativeBackend_RoundTrip_NoDuplicateSystemDefs; procedure TestGenericClass_RoundTrip_WithoutSource; procedure TestUninstantiatedGenericFunc_InUnit_Compiles; procedure TestDuplicateExternalAcrossUnits_Compiles; @@ -187,6 +188,76 @@ begin AssertEquals('use_mydep stdout', 'Triple(7) = 21' + #10, Captured) end; +procedure TSepCompileTests.TestNativeBackend_RoundTrip_NoDuplicateSystemDefs; +const + { Same round-trip as TestFreeRoutine_RoundTrip_WithoutSource but pins the + NATIVE backend explicitly. Guards the regression where the native + unit-to-.o path emitted the built-in system defs (typeinfo_/vtable_/ + _FieldCleanup_ for TObject and TCustomAttribute) into every unit .o, + colliding with the consumer program at link ("multiple definition of + vtable_TCustomAttribute"). Pinning --backend native keeps the guard valid + regardless of which backend is the compiler default. } + DepSrc = + ''' + unit NatDep; + interface + function Triple(N: Integer): Integer; + implementation + function Triple(N: Integer): Integer; + begin + Result := N * 3 + end; + end. + '''; + ProgSrc = + ''' + program UseNatDep; + uses NatDep; + begin + WriteLn('Triple(7) = ', Triple(7)) + end. + '''; +var + DepPas, DepObj, ProgPas, ProgBin: string; + Captured: string; + Rc: Integer; +begin + if not ToolchainAvailable() then + begin + Fail('toolchain missing — qbe or RTL not found'); + Exit + end; + if not FileExists(BlaisePath()) then + begin + Fail('blaise binary missing at ' + BlaisePath()); + Exit + end; + + DepPas := FScratch + '/NatDep.pas'; + DepObj := FScratch + '/NatDep.o'; + ProgPas := FScratch + '/use_natdep.pas'; + ProgBin := FScratch + '/use_natdep'; + + WriteFile(DepPas, DepSrc); + Rc := RunBlaise(['--backend', 'native', '--source', DepPas, + '--output', DepObj], Captured); + AssertEquals('blaise(NatDep, native) exit code', 0, Rc); + AssertTrue('NatDep.o exists', FileExists(DepObj)); + + DeleteFile(DepPas); + + WriteFile(ProgPas, ProgSrc); + Rc := RunBlaise(['--backend', 'native', '--source', ProgPas, + '--output', ProgBin, '--unit-path', FScratch], Captured); + AssertEquals('blaise(use_natdep, native) exit code (link must not collide): ' + + Captured, 0, Rc); + AssertTrue('use_natdep exists', FileExists(ProgBin)); + + Rc := RunBinary(ProgBin, Captured); + AssertEquals('use_natdep exit code', 0, Rc); + AssertEquals('use_natdep stdout', 'Triple(7) = 21' + #10, Captured) +end; + procedure TSepCompileTests.TestGenericClass_RoundTrip_WithoutSource; const DepSrc =