[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.

1 files changed, 20 insertions, 3 deletions

diff --git a/ghc/tests/ccall/should_run/fed001.hs b/ghc/tests/ccall/should_run/fed001.hs
index 57a52817a0..209750a3ec 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