[project @ 2001-03-28 05:07:34 by kglynn]

Cpr needs the correct arity for an imported function.  In some cases
the arity reported in the interface can be too small.

In this test case the function is returning a newtype,  and the newtype
is hiding a function.  The arity in the interface file says 0.  It is
triggered by compiling the cpr001.hs test files with profiling on. The code
comes from a bug report.

I should look for a better case,  because the profiling flaw which reveals
this problem will hopefully go away some time.

diff --git a/ghc/tests/cpranal/Makefile b/ghc/tests/cpranal/Makefile
new file mode 100644 (file)
index 0000000..5268832
--- /dev/null
+++ b/ghc/tests/cpranal/Makefile
@@ -0,0 +1,7 @@
+TOP = ..
+include $(TOP)/mk/boilerplate.mk
+
+SUBDIRS = should_compile
+
+include $(TOP)/mk/target.mk
+

diff --git a/ghc/tests/cpranal/should_compile/Cpr001.hs b/ghc/tests/cpranal/should_compile/Cpr001.hs
new file mode 100644 (file)
index 0000000..0871205
--- /dev/null
+++ b/ghc/tests/cpranal/should_compile/Cpr001.hs
@@ -0,0 +1,16 @@
+module Cpr001
+    (intpInstr) where
+
+import Cpr001_imp
+
+-- -------------------------------------------------------------------
+
+intpInstr      :: Instr -> MST ()
+
+intpInstr (SysCall "exit")
+    = setMTerminated
+
+intpInstr (SysCall call)
+    = setMSvc call
+
+-- -------------------------------------------------------------------

diff --git a/ghc/tests/cpranal/should_compile/Cpr001_imp.hs b/ghc/tests/cpranal/should_compile/Cpr001_imp.hs
new file mode 100644 (file)
index 0000000..0b48d89
--- /dev/null
+++ b/ghc/tests/cpranal/should_compile/Cpr001_imp.hs
@@ -0,0 +1,55 @@
+-- $Id: Cpr001_imp.hs,v 1.1 2001/03/28 05:07:34 kglynn Exp $
+
+module Cpr001_imp where
+
+data MS                = MS { instr    :: String
+                    , pc       :: Int
+                    , mem      :: String
+                    , stack    :: String
+                    , frames   :: [String]
+                    , status   :: Maybe String
+                    }
+
+
+newtype StateTrans s a = ST ( s -> (s, Maybe a))
+
+-- state monad with error handling
+-- in case of an error, the state remains
+-- as it is and Nothing is returned as value
+-- else execution continues
+
+instance Monad (StateTrans s) where
+    (ST p) >>= k
+       = ST (\s0 -> let
+                    (s1, r0)   = p s0
+                    in
+                    case r0 of
+                    Just v -> let
+                               (ST q) = k v
+                              in
+                              q s1
+                    Nothing -> (s1, Nothing)
+            )
+    return v
+       = ST (\s -> (s, Just v))
+
+
+-- machine state transitions
+
+type MachineStateTrans = StateTrans MS
+
+type MST = MachineStateTrans
+
+{-# NOINLINE setMTerminated #-}
+setMTerminated
+    = ST (\ms -> (ms { status = Just "Terminated" }, Just ()))
+
+setMSvc call
+    = ST (\ms -> (ms { status = Just "Service" }, Just ()))
+
+-- -------------------------------------------------------------------
+
+data Instr
+    = LoadI            Int             -- load int const
+    | SysCall          String          -- system call (svc)
+

diff --git a/ghc/tests/cpranal/should_compile/Makefile b/ghc/tests/cpranal/should_compile/Makefile
new file mode 100644 (file)
index 0000000..e989a83
--- /dev/null
+++ b/ghc/tests/cpranal/should_compile/Makefile
@@ -0,0 +1,7 @@
+TOP = ../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/should_compile.mk
+
+SRC_HC_OPTS += -O -prof -auto-all
+
+include $(TOP)/mk/target.mk