Browse Source

* Added test to attempt to catch access violation caused by faulty optimisation (i40165)

J. Gareth "Curious Kit" Moreton 2 years ago
parent
commit
0a89e68d55
3 changed files with 37 additions and 0 deletions
  1. 33 0
      tests/webtbs/tw40165.pp
  2. 2 0
      tests/webtbs/tw40165a.pp
  3. 2 0
      tests/webtbs/tw40165b.pp

+ 33 - 0
tests/webtbs/tw40165.pp

@@ -0,0 +1,33 @@
+{ %OPT=-O1 }
+
+{ This test attempts to catch the incorrect optimisation that occurred
+  sometimes when CMOV was allowed to use a normally-unsafe reference.
+  The code in question borrows from TObject.GetInterfaceByStr, where
+  the fault was first detected }
+
+program tw40165;
+
+{$mode objfpc} {$modeswitch advancedrecords}
+type
+    InterfaceEntry = record
+        iid: ^pInt32;
+        function GetIID: pInt32; inline;
+    end;
+
+    function InterfaceEntry.GetIID: pInt32;
+    begin
+        if Assigned(iid) then result := iid^ else result := nil;
+    end;
+
+var
+  ieStore: InterfaceEntry = (iid: nil);
+  ie: ^InterfaceEntry = @ieStore;
+
+begin
+  if Assigned(ie) and Assigned(ie^.GetIID) then
+    begin
+      writeln('FAIL - condition incorrect');
+      halt(1);
+    end;
+  writeln('ok');
+end.

+ 2 - 0
tests/webtbs/tw40165a.pp

@@ -0,0 +1,2 @@
+{ %OPT=-O2 }
+{$I tw40165.pp}

+ 2 - 0
tests/webtbs/tw40165b.pp

@@ -0,0 +1,2 @@
+{ %OPT=-O3 }
+{$I tw40165.pp}