瀏覽代碼

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

J. Gareth "Curious Kit" Moreton 2 年之前
父節點
當前提交
cf3faba5a2
共有 3 個文件被更改,包括 37 次插入0 次删除
  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}