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 =