Use -ddump-strsigs in tests/stranal/sigs
authorJoachim Breitner <mail@joachim-breitner.de>
Mon, 9 Dec 2013 15:40:20 +0000 (15:40 +0000)
committerJoachim Breitner <mail@joachim-breitner.de>
Mon, 9 Dec 2013 15:40:20 +0000 (15:40 +0000)
because it is more reliable than the previous GHC plugin (no need to
support annotations etc.), plus it works nicely with "make accept".

testsuite/tests/stranal/sigs/HyperStrUse.hs
testsuite/tests/stranal/sigs/HyperStrUse.stderr [new file with mode: 0644]
testsuite/tests/stranal/sigs/StrAnalAnnotation.hs [deleted file]
testsuite/tests/stranal/sigs/StrAnalExample.hs
testsuite/tests/stranal/sigs/StrAnalExample.stderr [new file with mode: 0644]
testsuite/tests/stranal/sigs/T8569.hs
testsuite/tests/stranal/sigs/T8569.stderr [new file with mode: 0644]
testsuite/tests/stranal/sigs/T8598.hs
testsuite/tests/stranal/sigs/T8598.stderr [new file with mode: 0644]
testsuite/tests/stranal/sigs/all.T

index 88ba3e3..14bdea4 100644 (file)
@@ -1,9 +1,5 @@
-{-# OPTIONS_GHC -fplugin StrAnalAnnotation #-}
 module HyperStrUse where
 
-import StrAnalAnnotation (StrAnal(StrAnal))
-
 f :: (Int, Int) -> Bool -> Int
 f (x,y) True = error (show x)
 f (x,y) False = x +1
-{-# ANN f (StrAnal "<S(SL),1*U(1*U(U),A)><S,1*U>m") #-}
diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
new file mode 100644 (file)
index 0000000..1a0ff33
--- /dev/null
@@ -0,0 +1,5 @@
+
+==================== Strictness signatures ====================
+HyperStrUse.f: <S(SL),1*U(1*U(U),A)><S,1*U>m
+
+
diff --git a/testsuite/tests/stranal/sigs/StrAnalAnnotation.hs b/testsuite/tests/stranal/sigs/StrAnalAnnotation.hs
deleted file mode 100644 (file)
index b5bfa75..0000000
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
-
--- | This module is not used in GHC. Rather, it is a module that
--- can be used to annotate functions with expected result of the demand
--- analyzer, and it will print warnings if they do not match.
--- This is primarily used for the GHC testsuite, but you can use it in your own
--- test suites as well.
-module StrAnalAnnotation (plugin, StrAnal(..)) where
-
-import GhcPlugins
-import Demand (StrictSig, pprIfaceStrictSig)
-
-import Data.Data
-import Control.Monad
-
--- | Use this to annotate your functions
-data StrAnal= StrAnal String deriving (Data, Typeable)
-
-plugin :: Plugin
-plugin = defaultPlugin {
-  installCoreToDos = install
-  }
-
-install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
-install _ todo = do
-  reinitializeGlobals
-  return (todo ++ [CoreDoPluginPass "Strictness Analzier result test" pass])
-
-pass :: ModGuts -> CoreM ModGuts
-pass g = mapM_ (printAnn g) (allIds (mg_binds g)) >> return g
-
-printAnn :: ModGuts -> Id -> CoreM ()
-printAnn guts b = do
-    anns <- annotationsOn guts b :: CoreM [StrAnal]
-    flags <- getDynFlags
-    mapM_ (report flags b) anns
-
-report :: DynFlags -> Id -> StrAnal -> CoreM ()
-report flags id (StrAnal ann)
-  | sigStr == ann = return ()
-  | otherwise = putMsg $
-      hang (text "Mismatch in expected strictness signature:") 4 $
-          vcat [ text "name:    " <+> ppr id
-               , text "expected:" <+> text ann
-               , text "found:   " <+> text sigStr
-               ]
- where sig = idStrictness id
-       sigStr = showSDoc flags (pprIfaceStrictSig (idStrictness id))
-
-allIds :: CoreProgram -> [Id]
-allIds = concatMap go
-  where go (NonRec i _) = [i]
-        go (Rec bs) = map fst bs
-
-annotationsOn :: Data a => ModGuts -> CoreBndr -> CoreM [a]
-annotationsOn guts bndr = do
-  anns <- getAnnotations deserializeWithData guts
-  return $ lookupWithDefaultUFM anns [] (varUnique bndr)
index af9180b..0ac61b9 100644 (file)
@@ -1,10 +1,5 @@
-{-# OPTIONS_GHC -fplugin StrAnalAnnotation #-}
-
 -- Just an example on how to create tests that test the strictness analizer
 
 module StrAnalExample where
 
-import StrAnalAnnotation (StrAnal(StrAnal))
-
 foo x = x
-{-# ANN foo (StrAnal "<S,1*U>") #-}
diff --git a/testsuite/tests/stranal/sigs/StrAnalExample.stderr b/testsuite/tests/stranal/sigs/StrAnalExample.stderr
new file mode 100644 (file)
index 0000000..dbe4770
--- /dev/null
@@ -0,0 +1,5 @@
+
+==================== Strictness signatures ====================
+StrAnalExample.foo: <S,1*U>
+
+
index ee6c413..17f7595 100644 (file)
@@ -1,10 +1,7 @@
-{-# OPTIONS_GHC -fplugin StrAnalAnnotation #-}
 {-# LANGUAGE GADTs #-}
 
 module T8569 where
 
-import StrAnalAnnotation (StrAnal(StrAnal))
-
 data Rep t where
   Rint :: Rep Int
   Rdata :: Rep i -> (t -> i) -> Rep t
@@ -12,4 +9,3 @@ data Rep t where
 addUp :: Rep a -> a -> Int
 addUp Rint n  = n
 addUp (Rdata i f) x = addUp i (f x)
-{-# ANN addUp (StrAnal "<S,1*U><L,U>") #-}
diff --git a/testsuite/tests/stranal/sigs/T8569.stderr b/testsuite/tests/stranal/sigs/T8569.stderr
new file mode 100644 (file)
index 0000000..d33935e
--- /dev/null
@@ -0,0 +1,5 @@
+
+==================== Strictness signatures ====================
+T8569.addUp: <S,1*U><L,U>
+
+
index 55c1a35..1e0ca6f 100644 (file)
@@ -1,11 +1,9 @@
-{-# OPTIONS_GHC -fplugin StrAnalAnnotation #-}
 {-# LANGUAGE  MagicHash , UnboxedTuples #-}
 
 module T8598(fun) where
 
 import GHC.Float (Double(..))
 import GHC.Integer (decodeDoubleInteger, encodeDoubleInteger)
-import StrAnalAnnotation (StrAnal(StrAnal))
 
 -- Float.scaleFloat for Doubles, slightly simplified
 fun :: Double -> Double
@@ -15,6 +13,5 @@ fun x | isFix           = x
             (# i, j #) -> D# (encodeDoubleInteger i j)
   where
   isFix = isDoubleFinite x == 0
-{-# ANN fun (StrAnal "<S(S),1*U(U)>m") #-}
 
 foreign import ccall unsafe "isDoubleFinite" isDoubleFinite :: Double -> Int
diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr
new file mode 100644 (file)
index 0000000..8de5d31
--- /dev/null
@@ -0,0 +1,5 @@
+
+==================== Strictness signatures ====================
+T8598.fun: <S(S),1*U(U)>m
+
+
index aee2ab3..247a077 100644 (file)
@@ -1,22 +1,14 @@
 # This directory contains tests where we annotate functions with expected
 # type signatures, and verify that these actually those found by the compiler
 
-def f(name, opts):
-  if (ghc_with_interpreter == 0):
-       opts.skip = 1
-
-setTestOpts(f)
-setTestOpts(when(compiler_lt('ghc', '7.1'), skip))
-setTestOpts(extra_clean(['StrAnalAnnotation.hi','StrAnalAnnotation.o']))
+setTestOpts(extra_hc_opts('-ddump-strsigs'))
 
 # We are testing the result of an optimization, so no use
 # running them in various runtimes
 setTestOpts(only_ways(['optasm']))
 
-# Use this as a template
-test('StrAnalExample', normal, compile, ['--make -package ghc -v0 ' + config.ghc_th_way_flags])
-
-test('T8569', expect_broken(8569), compile, ['--make -package ghc -v0 ' + config.ghc_th_way_flags])
-test('HyperStrUse', normal, compile, ['--make -package ghc -v0 ' + config.ghc_th_way_flags])
-test('T8598', expect_broken(8598), compile, ['--make -package ghc -v0 ' + config.ghc_th_way_flags])
+test('StrAnalExample', normal, compile, [''])
+test('T8569', expect_broken(8569), compile, [''])
+test('HyperStrUse', normal, compile, [''])
+test('T8598', expect_broken(8598), compile, [''])