+ whole program optimisation tests

git-svn-id: branches/wpo@12332 -

.gitattributes

@@ -7594,6 +7594,11 @@ tests/test/opt/treg3.pp svneol=native#text/plain
 tests/test/opt/treg4.pp svneol=native#text/plain
 tests/test/opt/tretopt.pp svneol=native#text/plain
 tests/test/opt/tspace.pp svneol=native#text/plain
+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/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
 tests/test/packages/fcl-db/dbftoolsunit.pas svneol=native#text/plain

tests/test/opt/twpo1.pp

@@ -0,0 +1,62 @@
+{ %wpoparas=devirtcalls,optvmts }
+{ %wpopasses=1 }
+
+{$mode objfpc}
+
+{ check to make sure that classes created via classrefdefs are properly
+  registered
+}
+
+type
+  ta = class
+    constructor mycreate;
+    procedure test; virtual;
+    class procedure test2; virtual;
+  end;
+
+  tb = class(ta)
+    procedure test; override;
+    class procedure test2; override;
+  end;
+
+constructor ta.mycreate;
+begin
+end;
+
+procedure ta.test;
+begin
+  writeln('ta.test');
+  halt(1);
+end;
+
+
+class procedure ta.test2;
+begin
+  writeln('ta.test2');
+end;
+
+
+var
+ cc: class of ta;
+
+
+procedure tb.test;
+begin
+  writeln('tb.test');
+end;
+
+class procedure tb.test2;
+begin
+  cc:=self;
+  writeln('tb.test2');
+end;
+
+var
+  a: ta;
+  ca: class of ta;
+begin
+  tb.test2;
+  a:=cc.create;
+  a.test;
+  a.free
+end.

tests/test/opt/twpo2.pp

@@ -0,0 +1,19 @@
+{ %wpoparas=devirtcalls,optvmts }
+{ %wpopasses=1 }
+
+{$mode objfpc}
+
+{ same as two1, except with a unit to test loading wpo info from a ppu file }
+
+uses
+  uwpo2;
+
+var
+  a: ta;
+  ca: class of ta;
+begin
+  tb.test2;
+  a:=cc.create;
+  a.test;
+  a.free
+end.

tests/test/opt/twpo3.pp

@@ -0,0 +1,54 @@
+{ %wpoparas=devirtcalls,optvmts }
+{ %wpopasses=1 }
+
+{$mode objfpc}
+
+{ check that multiple descendents properly mark parent class method as
+  non-optimisable
+}
+
+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;
+
+procedure tchild1.test;
+begin
+  if a<>1 then
+    halt(2);
+end;
+
+procedure tchild2.test;
+begin
+  if a<>2 then
+    halt(3);
+end;
+
+var
+  bb: tbase;
+begin
+  bb:=tchild1.create;
+  a:=1;
+  bb.test;
+  a:=2;
+  bb.free;
+  bb:=tchild2.create;
+  bb.test;
+  bb.free;
+end.

tests/test/opt/twpo4.pp

@@ -0,0 +1,66 @@
+{ %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;
+
+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
+  bb:=tchild2.create;
+  bb.test;
+  bb.free;
+end;
+
+var
+  bb: tbase;
+begin
+  bb:=tchild1.create;
+  a:=1;
+  bb.test;
+  a:=2;
+  bb.free;
+end.

tests/test/opt/uwpo2.pp

@@ -0,0 +1,52 @@
+{$mode objfpc}
+unit uwpo2;
+
+interface
+
+type
+  ta = class
+    constructor mycreate;
+    procedure test; virtual;
+    class procedure test2; virtual;
+  end;
+
+  tb = class(ta)
+    procedure test; override;
+    class procedure test2; override;
+  end;
+
+var
+ cc: class of ta;
+
+implementation
+
+constructor ta.mycreate;
+begin
+end;
+
+procedure ta.test;
+begin
+  writeln('ta.test');
+  halt(1);
+end;
+
+
+class procedure ta.test2;
+begin
+  writeln('ta.test2');
+end;
+
+
+
+procedure tb.test;
+begin
+  writeln('tb.test');
+end;
+
+class procedure tb.test2;
+begin
+  cc:=self;
+  writeln('tb.test2');
+end;
+
+end.