From 47ba5b19ec4d5657b25073004df6e53d024fbedf Mon Sep 17 00:00:00 2001
From: Jonas Maebe <jonas@freepascal.org>
Date: Sun, 14 Dec 2008 18:56:02 +0000
Subject: [PATCH]   * ignore vmtloadaddrnodes created in dead strip removed
 code     for wpo

git-svn-id: trunk@12364 -
---
 .gitattributes          |  1 +
 compiler/nmem.pas       | 16 +++++++---
 tests/test/opt/twpo5.pp | 69 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 81 insertions(+), 5 deletions(-)
 create mode 100644 tests/test/opt/twpo5.pp

diff --git a/.gitattributes b/.gitattributes
index bdec5342f7..8a13600c30 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -7606,6 +7606,7 @@ tests/test/opt/twpo1.pp svneol=native#text/plain
 tests/test/opt/twpo2.pp svneol=native#text/plain
 tests/test/opt/twpo3.pp svneol=native#text/plain
 tests/test/opt/twpo4.pp svneol=native#text/plain
+tests/test/opt/twpo5.pp svneol=native#text/plain
 tests/test/opt/uwpo2.pp svneol=native#text/plain
 tests/test/packages/fcl-base/tgettext1.pp svneol=native#text/plain
 tests/test/packages/fcl-db/assertions.pas svneol=native#text/plain
diff --git a/compiler/nmem.pas b/compiler/nmem.pas
index 9874fc14d6..63e0c9bd01 100644
--- a/compiler/nmem.pas
+++ b/compiler/nmem.pas
@@ -134,6 +134,7 @@ implementation
       cutils,verbose,globals,
       symconst,symbase,defutil,defcmp,
       nbas,nutils,
+      wpobase,
       htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase,procinfo
       ;
 
@@ -171,11 +172,16 @@ implementation
          expectloc:=LOC_REGISTER;
          if left.nodetype<>typen then
            firstpass(left)
-         { keep track of which classes might be instantiated via a classrefdef }
-         else if (left.resultdef.typ=classrefdef) then
-           tobjectdef(tclassrefdef(left.resultdef).pointeddef).register_maybe_created_object_type
-         else if (left.resultdef.typ=objectdef) then
-           tobjectdef(left.resultdef).register_maybe_created_object_type;
+         else if not assigned(current_procinfo) or
+             (po_inline in current_procinfo.procdef.procoptions) or
+             wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname) then
+           begin
+             { keep track of which classes might be instantiated via a classrefdef }
+             if (left.resultdef.typ=classrefdef) then
+               tobjectdef(tclassrefdef(left.resultdef).pointeddef).register_maybe_created_object_type
+             else if (left.resultdef.typ=objectdef) then
+               tobjectdef(left.resultdef).register_maybe_created_object_type
+           end
       end;
 
 
diff --git a/tests/test/opt/twpo5.pp b/tests/test/opt/twpo5.pp
new file mode 100644
index 0000000000..517ff76ec1
--- /dev/null
+++ b/tests/test/opt/twpo5.pp
@@ -0,0 +1,69 @@
+{ %target=darwin,linux,freebsd,solaris }
+{ %wpoparas=devirtcalls,optvmts,symbolliveness }
+{ %wpopasses=2 }
+{ %opt=-CX -XX -Xs- }
+
+{ not enabled for windows yet because symbolliveness doesn't work there without
+  installing "nm" (until implemented by way of internal linker there)
+}
+
+{$mode objfpc}
+
+{ test case that can be optimised based on taking into account dead code
+  stripping
+}
+
+type
+  tbase = class
+    procedure test; virtual;
+  end;
+
+  tchild1 = class(tbase)
+    procedure test; override;
+  end;
+
+  tchild2 = class(tbase)
+    procedure test; override;
+  end;
+
+procedure tbase.test;
+begin
+  halt(1);
+end;
+
+var
+  a: longint;
+  cc: class of tbase;
+
+procedure tchild1.test;
+begin
+  if a<>1 then
+    halt(2);
+end;
+
+procedure tchild2.test;
+begin
+  if a<>2 then
+    halt(3);
+end;
+
+procedure notcalled;
+var
+  bb: tbase;
+begin
+  cc:=tchild2;
+  bb:=cc.create;
+  bb.test;
+  bb.free;
+end;
+
+var
+  bb: tbase;
+begin
+  cc:=tchild1;
+  bb:=cc.create;
+  a:=1;
+  bb.test;
+  a:=2;
+  bb.free;
+end.