Test annotations

testsuite/tests/ghc-regress/annotations/Makefile

+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_compile/Makefile

+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_compile/all.T

+# Annotations were implemented in GHC 6.9 and not supported in other compilers
+setTestOpts(if_compiler_lt('ghc', '6.9', skip));
+
+test('ann01', normal, compile, [''])
+
+""""
+Helpful things to C+P:
+
+test('', normal, compile_fail, [''])
+
+test('', normal, compile, [''])
+
+test('', extra_clean(['.hi', '.o']), 
+     multimod_compile_fail, ['', '-v0'])
+
+test('', extra_clean(['.hi', '.o']), 
+     multimod_compile, ['', '-v0'])
+"""
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_compile/ann01.hs

+{-# LANGUAGE TemplateHaskell #-}
+
+module Ann01 where
+
+{-# ANN module (1 :: Int) #-}
+{-# ANN module (1 :: Integer) #-}
+{-# ANN module (1 :: Double) #-}
+{-# ANN module $([| 1 :: Int |]) #-}
+{-# ANN module "Hello" #-}
+{-# ANN module (Just (1 :: Int)) #-}
+{-# ANN module [1 :: Int, 2, 3] #-}
+{-# ANN module ([1..10] :: [Integer]) #-}
+{-# ANN module ''Foo #-}
+{-# ANN module (-1 :: Int) #-}
+
+{-# ANN type Foo (1 :: Int) #-}
+{-# ANN type Foo (1 :: Integer) #-}
+{-# ANN type Foo (1 :: Double) #-}
+{-# ANN type Foo $([| 1 :: Int |]) #-}
+{-# ANN type Foo "Hello" #-}
+{-# ANN type Foo (Just (1 :: Int)) #-}
+{-# ANN type Foo [1 :: Int, 2, 3] #-}
+{-# ANN type Foo ([1..10] :: [Integer]) #-}
+{-# ANN type Foo ''Foo #-}
+{-# ANN type Foo (-1 :: Int) #-}
+data Foo = Bar Int
+
+{-# ANN f (1 :: Int) #-}
+{-# ANN f (1 :: Integer) #-}
+{-# ANN f (1 :: Double) #-}
+{-# ANN f $([| 1 :: Int |]) #-}
+{-# ANN f "Hello" #-}
+{-# ANN f (Just (1 :: Int)) #-}
+{-# ANN f [1 :: Int, 2, 3] #-}
+{-# ANN f ([1..10] :: [Integer]) #-}
+{-# ANN f 'f #-}
+{-# ANN f (-1 :: Int) #-}
+f x = x

testsuite/tests/ghc-regress/annotations/should_compile/ann01.stderr

+Loading package ghc-prim ... linking ... done.
+Loading package integer ... linking ... done.
+Loading package base ... linking ... done.
+Loading package ffi-1.0 ... linking ... done.
+Loading package syb ... linking ... done.
+Loading package array-0.2.0.0 ... linking ... done.
+Loading package containers-0.2.0.0 ... linking ... done.
+Loading package packedstring-0.1.0.1 ... linking ... done.
+Loading package pretty-1.0.1.0 ... linking ... done.
+Loading package template-haskell ... linking ... done.

testsuite/tests/ghc-regress/annotations/should_fail/Annfail04_Help.hs

+module Annfail04_Help where
+
+class Thing a where
+  thing :: a
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/Annfail05_Help.hs

+module Annfail05_Help where
+
+data NoInstances = NoInstances
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/Annfail06_Help.hs

+module Annfail06_Help where
+
+data InstancesInWrongModule = InstancesInWrongModule
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/Makefile

+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/all.T

+# Annotations were implemented in GHC 6.9 and not supported in other compilers
+setTestOpts(if_compiler_lt('ghc', '6.9', skip));
+
+test('annfail01', normal, compile_fail, [''])
+test('annfail02', normal, compile_fail, [''])
+test('annfail03', normal, compile_fail, [''])
+test('annfail04', extra_clean(['Annfail04_Help.hi', 'Annfail04_Help.o']), 
+     multimod_compile_fail, ['annfail04', '-v0'])
+test('annfail05', extra_clean(['Annfail05_Help.hi', 'Annfail05_Help.o']), 
+     multimod_compile_fail, ['annfail05', '-v0'])
+test('annfail06', extra_clean(['Annfail06_Help.hi', 'Annfail06_Help.o']), 
+     multimod_compile_fail, ['annfail06', '-v0'])
+test('annfail07', normal, compile_fail, [''])
+test('annfail08', normal, compile_fail, [''])
+test('annfail09', normal, compile_fail, [''])
+test('annfail10', normal, compile_fail, [''])
+test('annfail11', normal, compile_fail, [''])
+test('annfail12', normal, compile_fail, [''])
+test('annfail13', normal, compile_fail, [''])
+
+""""
+Helpful things to C+P:
+
+test('', normal, compile_fail, [''])
+
+test('', normal, compile, [''])
+
+test('', extra_clean(['.hi', '.o']), 
+     multimod_compile_fail, ['', '-v0'])
+
+test('', extra_clean(['.hi', '.o']), 
+     multimod_compile, ['', '-v0'])
+"""
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail01.hs

+module Annfail01 where
+-- Testing annotating things that don't exist
+
+{-# ANN type Foo (1 :: Int) #-}
+{-# ANN f (1 :: Int) #-}
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail01.stderr

+
+annfail01.hs:4:0: Not in scope: type constructor or class `Foo'
+
+annfail01.hs:5:0: Not in scope: `f'

testsuite/tests/ghc-regress/annotations/should_fail/annfail02.hs

+module Annfail02 where
+-- Testing annotating things that don't exist in the right namespace
+
+data Foo = Bar
+
+{-# ANN Foo (1 :: Int) #-}
+{-# ANN type Bar (2 :: Int) #-}
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail02.stderr

+
+annfail02.hs:6:0: Not in scope: data constructor `Foo'
+
+annfail02.hs:7:0: Not in scope: type constructor or class `Bar'

testsuite/tests/ghc-regress/annotations/should_fail/annfail03.hs

+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Annfail03 where
+-- Testing annotating something with a value defined + Typeabled / Dataed in same module
+
+import Data.Data
+import Data.Typeable
+
+data InModule = InModule
+              deriving (Typeable, Data)
+
+{-# ANN module InModule #-}
+
+{-# ANN type Foo InModule #-}
+data Foo = Bar
+
+{-# ANN f InModule #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail03.stderr

+
+annfail03.hs:17:0:
+    GHC stage restriction: instance for `Data InModule'
+      is used in an annotation, and must be imported, not defined locally
+    In the expression: InModule
+    In the annotation: {-# ANN f InModule #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail04.hs

+module Annfail04 where
+
+import Annfail04_Help
+-- Testing that we detect the use of instances defined in the same module
+
+instance Thing Int where
+  thing = 1
+
+{-# ANN module (thing :: Int) #-}
+
+{-# ANN type Foo (thing :: Int) #-}
+data Foo = Bar
+
+{-# ANN f (thing :: Int) #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail04.stderr

+
+annfail04.hs:14:11:
+    GHC stage restriction: instance for `Thing Int'
+      is used in an annotation, and must be imported, not defined locally
+    In the expression: (thing :: Int)
+    In the annotation: {-# ANN f (thing :: Int) #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail05.hs

+module Annfail05 where
+
+import Annfail05_Help
+-- Testing annotating with a value that is not Typeable or Data-able
+
+{-# ANN module NoInstances #-}
+
+{-# ANN type Foo NoInstances #-}
+data Foo = Bar
+
+{-# ANN f NoInstances #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail05.stderr

+
+annfail05.hs:11:0:
+    No instance for (Data.Data.Data NoInstances)
+      arising from an annotation at annfail05.hs:11:0-24
+    Possible fix:
+      add an instance declaration for (Data.Data.Data NoInstances)
+    In the expression: NoInstances
+    In the annotation: {-# ANN f NoInstances #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail06.hs

+module Annfail06 where
+-- Testing that we don't accept Typeable or Data instances defined in the same module
+
+import Annfail06_Help
+
+import Data.Data
+import Data.Typeable
+
+instance Typeable InstancesInWrongModule where
+    typeOf _ = undefined
+
+instance Data InstancesInWrongModule where
+    gfoldl = undefined
+    gunfold = undefined
+
+{-# ANN module InstancesInWrongModule #-}
+
+{-# ANN type Foo InstancesInWrongModule #-}
+data Foo = Bar
+
+{-# ANN f InstancesInWrongModule #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail06.stderr

+
+annfail06.hs:21:0:
+    GHC stage restriction: instance for `Data InstancesInWrongModule'
+      is used in an annotation, and must be imported, not defined locally
+    In the expression: InstancesInWrongModule
+    In the annotation: {-# ANN f InstancesInWrongModule #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail07.hs

+module Annfail07 where
+-- Testing normal type errors in annotations
+
+{-# ANN module (head True) #-}
+
+{-# ANN type Foo (head True) #-}
+data Foo = Bar
+
+{-# ANN f (head True) #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail07.stderr

+
+annfail07.hs:9:16:
+    Couldn't match expected type `[a]' against inferred type `Bool'
+    In the first argument of `head', namely `True'
+    In the expression: (head True)
+    In the annotation: {-# ANN f (head True) #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail08.hs

+module Annfail08 where
+-- Testing instance type errors in annotations
+
+{-# ANN module (id + 1) #-}
+
+{-# ANN type Foo (id + 1) #-}
+data Foo = Bar
+
+{-# ANN f (id + 1) #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail08.stderr

+
+annfail08.hs:9:0:
+    No instance for (Data.Data.Data (a -> a))
+      arising from an annotation at annfail08.hs:9:0-21
+    Possible fix:
+      add an instance declaration for (Data.Data.Data (a -> a))
+    In the expression: (id + 1)
+    In the annotation: {-# ANN f (id + 1) #-}
+
+annfail08.hs:9:16:
+    No instance for (Num (a -> a))
+      arising from the literal `1' at annfail08.hs:9:16
+    Possible fix: add an instance declaration for (Num (a -> a))
+    In the second argument of `(+)', namely `1'
+    In the expression: (id + 1)
+    In the annotation: {-# ANN f (id + 1) #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail09.hs

+module Annfail09 where
+-- Testing that we detect references to ids defined in module being compiled in annotations
+
+g = 10
+
+{-# ANN module g #-}
+
+{-# ANN type Foo g #-}
+data Foo = Bar
+
+{-# ANN f g #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail09.stderr

+
+annfail09.hs:11:10:
+    GHC stage restriction: `g'
+      is used in an annotation, and must be imported, not defined locally
+    In the expression: g
+    In the annotation: {-# ANN f g #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail10.hs

+module Annfail10 where
+-- Testing ambiguity in annotations
+
+{-# ANN module 1 #-}
+
+{-# ANN type Foo 1 #-}
+data Foo = Bar
+
+{-# ANN f 1 #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail10.stderr

+
+annfail10.hs:9:10:
+    Ambiguous type variable `t' in the constraints:
+      `Num t' arising from the literal `1' at annfail10.hs:9:10
+      `Data.Data.Data t'
+        arising from an annotation at annfail10.hs:9:0-14
+    Probable fix: add a type signature that fixes these type variable(s)
+    In the expression: 1
+    In the annotation: {-# ANN f 1 #-}

testsuite/tests/ghc-regress/annotations/should_fail/annfail11.hs

+module Annfail11 where
+
+{-# ANN length "Cannot annotate other modules yet" #-}
+{-# ANN type Integer "Cannot annotate other modules yet" #-}
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail11.stderr

+
+annfail11.hs:3:0: Not in scope: `length'
+
+annfail11.hs:4:0: Not in scope: type constructor or class `Integer'

testsuite/tests/ghc-regress/annotations/should_fail/annfail12.hs

+module Annfail12 where
+
+-- Testing errors hidden in annotations
+
+{-# ANN f (error "You were meant to see this error!" :: Int) #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail12.stderr

+
+annfail12.hs:5:0:
+    Exception when trying to run compile-time code:
+      You were meant to see this error!
+    In the expression:
+        (error "You were meant to see this error!" :: Int)
+    In the annotation:
+        {-# ANN f (error "You were meant to see this error!" :: Int) #-}
+Loading package ghc-prim ... linking ... done.
+Loading package integer ... linking ... done.
+Loading package base ... linking ... done.
+Loading package ffi-1.0 ... linking ... done.

testsuite/tests/ghc-regress/annotations/should_fail/annfail13.hs

+module Annfail13 where
+-- Testing that brackets are mandatory in the ANN syntax
+
+{-# ANN f id 1 #-}
+{-# ANN f 1 :: Int #-}
+f x = x
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_fail/annfail13.stderr

+
+annfail13.hs:4:13: parse error on input `1'

testsuite/tests/ghc-regress/annotations/should_run/Annrun01_Help.hs

+{-# LANGUAGE TemplateHaskell #-}
+
+module Annrun01_Help where
+
+{-# ANN module "Module" #-}
+{-# ANN module "Annotations" #-}
+{-# ANN module (10 :: Int) #-}
+{-# ANN module "Rock!!!!" #-}
+
+
+{-# ANN foo "Hello" #-}
+{-# ANN foo "World!" #-}
+{-# ANN bar 'foo #-}
+foo = "Never seen"
+
+{-# ANN bar "Hello World Again!" #-}
+{-# ANN bar (1 :: Int) #-}
+{-# ANN bar 'bar #-}
+bar = "Also never seen"
+
+baz = "Especially never seen"
+
+
+{-# ANN type Baz "Type Annotation" #-}
+{-# ANN type Baz (Just True) #-}
+{-# ANN type Baz ''Baz #-}
+data Baz = Spqr
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_run/Makefile

+TOP=../../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+CONFIG_HS=Config.hs
+
+clean :
+	rm -f $(CONFIG_HS)
+
+config : 
+	rm -f $(CONFIG_HS)
+	@echo "Creating $(CONFIG_HS) ... "
+	@echo "module Config where" >>$(CONFIG_HS)
+	@echo "cTop          :: String" >> $(CONFIG_HS)
+	@echo "cTop          = \""`cd $(TOP) && cd .. && pwd`"\"" >> $(CONFIG_HS)
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_run/all.T

+# Annotations were implemented in GHC 6.9 and not supported in other compilers
+# These tests are very slow due to their use of package GHC
+setTestOpts(compose(skip_if_fast, if_compiler_lt('ghc', '6.9', skip)));
+
+runCmd('$MAKE -C ' + in_testdir('') + ' config')
+
+test('annrun01',
+      extra_clean(['Annrun01_Help.hi', 'Annrun01_Help.o',
+                    'annrun01.hi', 'annrun01.o']),
+      multimod_compile_and_run,
+      ['annrun01', '-package ghc']
+    )
+
+if default_testopts.cleanup != '':
+    runCmd('$MAKE -C ' + in_testdir('') + ' clean')
+
+""""
+Helpful things to C+P:
+
+test('', normal, compile_fail, [''])
+
+test('', normal, compile, [''])
+
+test('', extra_clean(['.hi', '.o']), 
+     multimod_compile_fail, ['', '-v0'])
+
+test('', extra_clean(['.hi', '.o']), 
+     multimod_compile, ['', '-v0'])
+"""
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_run/annrun01.hs

+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Main where
+
+import GHC
+import MonadUtils  ( liftIO )
+import DynFlags    ( defaultDynFlags )
+import Annotations ( AnnTarget(..), CoreAnnTarget )
+import Serialized  ( deserializeWithData )
+
+import Config
+import Annrun01_Help
+
+import qualified Language.Haskell.TH as TH
+
+main = defaultErrorHandler defaultDynFlags $ runGhc (Just cTop) $ do
+    liftIO $ putStrLn "Initializing Package Database"
+    dflags <- getSessionDynFlags
+    let dflags' = dflags
+    setSessionDynFlags dflags'
+    
+    let mod_nm = mkModuleName "Annrun01_Help"
+    
+    liftIO $ putStrLn "Setting Target"
+    setTargets [Target (TargetModule mod_nm) True Nothing]
+    liftIO $ putStrLn "Loading Targets"
+    load LoadAllTargets
+    
+    liftIO $ putStrLn "Finding Module"
+    mod <- findModule mod_nm Nothing
+    liftIO $ putStrLn "Getting Module Info"
+    Just mod_info <- getModuleInfo mod
+    
+    liftIO $ putStrLn "Showing Details For Module"
+    showTargetAnns (ModuleTarget mod)
+    liftIO $ putStrLn "Showing Details For Exports"
+    mapM (showTargetAnns . NamedTarget) $ modInfoExports mod_info
+
+showTargetAnns :: CoreAnnTarget -> Ghc ()
+showTargetAnns target = do
+    (int_anns     :: [Int])        <- findGlobalAnns deserializeWithData target
+    (mb_bool_anns :: [Maybe Bool]) <- findGlobalAnns deserializeWithData target
+    (string_anns  :: [String])     <- findGlobalAnns deserializeWithData target
+    (name_anns    :: [TH.Name])    <- findGlobalAnns deserializeWithData target
+    liftIO $ print (int_anns, mb_bool_anns, string_anns, name_anns)
\ No newline at end of file

testsuite/tests/ghc-regress/annotations/should_run/annrun01.stdout

+Initializing Package Database
+Setting Target
+Loading Targets
+Finding Module
+Getting Module Info
+Showing Details For Module
+([10],[],["Rock!!!!","Annotations","Module"],[])
+Showing Details For Exports
+([],[Just True],["Type Annotation"],[Annrun01_Help.Baz])
+([],[],[],[])
+([1],[],["Hello World Again!"],[Annrun01_Help.bar,Annrun01_Help.foo])
+([],[],[],[])
+([],[],["World!","Hello"],[])