From: sewardj <unknown>
Date: Wed, 22 Aug 2001 11:45:06 +0000 (+0000)
Subject: [project @ 2001-08-22 11:45:06 by sewardj]
X-Git-Tag: Approximately_9120_patches~1128
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=f2eadfd5dfb23cc611e2540f46180bca7d095f15;p=ghc-hetmet.git

[project @ 2001-08-22 11:45:06 by sewardj]
Count comparisons and bomb about after 100, to avoid infinite loop
due to buggy f-x-dynamic implementation on sparc-solaris.
---

diff --git a/ghc/tests/ccall/should_run/fed001.hs b/ghc/tests/ccall/should_run/fed001.hs
index 57a5281..209750a 100644
--- a/ghc/tests/ccall/should_run/fed001.hs
+++ b/ghc/tests/ccall/should_run/fed001.hs
@@ -1,6 +1,15 @@
 import Foreign
 import Monad
 import Addr
+import System
+import IO
+
+import IOExts
+global :: a -> IORef a
+global a = unsafePerformIO (newIORef a)
+{-# NOINLINE global #-}
+v_NumCmps = global 0 :: IORef Int
+{-# NOINLINE v_NumCmps #-}
 
 newtype XPtr a = XPtr Addr
 unXPtr (XPtr (A# x)) = x
@@ -18,9 +27,17 @@ foreign import
 
 compareInts :: XPtr Int -> XPtr Int -> IO CInt
 compareInts a1 a2 = do
-   i1 <- peek (Ptr (unXPtr a1))
-   i2 <- peek (Ptr (unXPtr a2))
-   return (fromIntegral (i1 - i2 :: Int))
+   num_cmps <- readIORef v_NumCmps
+   if num_cmps < 100
+    then 
+     do writeIORef v_NumCmps (num_cmps+1)
+        i1 <- peek (Ptr (unXPtr a1))
+        i2 <- peek (Ptr (unXPtr a2))
+        return (fromIntegral (i1 - i2 :: Int))
+    else
+     do hPutStrLn stderr 
+                  "compareInts: 100 comparisons exceeded; something's wrong"
+        exitWith (ExitFailure 1)
 
 main :: IO ()
 main = do