[project @ 2001-06-22 12:28:32 by sewardj]

Add deSugar tests.

testsuite/tests/ghc-regress/NOTES

@@ -24,3 +24,7 @@ specialise/
 simpleCore/should_compile
    simpl006 has extra bits
 
+deSugar/should_compile
+   cvh-ds-unboxed/ not done
+
+

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

+
+include ($confdir ++ "/../vanilla-test.T")
+
+-- Args to vtc are: extra compile flags
+
+-- Use this itsy helper fn to pass in an extra flag
+--def myvtc($extra_comp_args)
+--{
+--   vtc(" -fno-warn-incomplete-patterns " ++ $extra_comp_args)
+--}
+
+test "ds-wildcard" { vtc("") }
+test "ds001" { vtc("") }
+test "ds002" { vtc("") }
+test "ds003" { vtc("") }
+test "ds004" { vtc("") }
+test "ds005" { vtc("") }
+test "ds006" { vtc("") }
+test "ds007" { vtc("") }
+test "ds008" { vtc("") }
+test "ds009" { vtc("") }
+test "ds010" { vtc("") }
+test "ds011" { vtc("") }
+test "ds012" { vtc("") }
+test "ds013" { vtc("") }
+test "ds014" { vtc("") }
+test "ds015" { vtc("") }
+test "ds016" { vtc("") }
+test "ds017" { vtc("") }
+test "ds018" { vtc("") }
+test "ds019" { vtc("") }
+test "ds020" { vtc("") }
+test "ds021" { vtc("") }
+test "ds022" { vtc("") }
+test "ds023" { vtc("") }
+test "ds024" { vtc("") }
+test "ds025" { vtc("") }
+test "ds026" { vtc("") }
+test "ds027" { vtc("") }
+test "ds028" { vtc("") }
+test "ds029" { vtc("") }
+test "ds030" { vtc("") }
+test "ds031" { vtc("") }
+test "ds032" { vtc("") }
+test "ds033" { vtc("") }
+test "ds034" { vtc("") }
+test "ds035" { vtc("-fglasgow-exts -package lang") }
+test "ds036" { vtc("") }
+test "ds037" { vtc("") }
+test "ds038" { vtc("") }
+test "ds039" { vtc("") }
+test "ds040" { vtc("") }
+test "ds041" { vtc("") }
+test "ds042" { vtc("") }
+test "ds043" { vtc("") }
+test "ds044" { vtc("") }
+test "ds045" { vtc("") }
+test "ds046" { vtc("-O -funbox-strict-fields") }
+test "ds047" { vtc("") }
+test "ds048" { vtc("") }
+test "ds049" { vtc("-fvia-C -package lang") }
+test "ds050" { vtc("-fglasgow-exts") }
+test "ds051" { vtc("") }

testsuite/tests/ghc-regress/deSugar/should_compile/ds-wildcard.hs

+module ShouldCompile where
+
+x@_ = x

testsuite/tests/ghc-regress/deSugar/should_compile/ds001.hs

+-- !!! ds001 -- simple function and pattern bindings
+--
+-- this tests ultra-simple function and pattern bindings (no patterns)
+
+module ShouldCompile where
+
+-- simple function bindings
+
+f x = x
+
+g x y z = f z
+
+j w x y z = g w x z
+
+h x y = f y
+  where
+    f a b = a
+
+-- simple pattern bindings
+
+a = b
+
+b = f
+
+c = c

testsuite/tests/ghc-regress/deSugar/should_compile/ds002.hs

+-- !!! ds002 -- overlapping equations and guards
+--
+-- this tests "overlapping" variables and guards
+
+module ShouldCompile where
+
+f x = x
+f y = y
+f z = z
+
+g x y z | True = f z
+    	| True = f z
+    	| True = f z
+g x y z | True = f z
+    	| True = f z
+    	| True = f z

testsuite/tests/ghc-regress/deSugar/should_compile/ds002.stderr

+
+ds002.hs:7: Warning: Pattern match(es) are overlapped in the definition of function `f':
+	    f y = ...
+	    f z = ...
+
+ds002.hs:11: Warning: Pattern match(es) are overlapped in the definition of function `g':
+	    g x y z = ...

testsuite/tests/ghc-regress/deSugar/should_compile/ds003.hs

+-- !!! ds003 -- list, tuple, lazy, as patterns
+--
+module ShouldCompile where
+
+f []		y	 True  = []
+f x		a@(y,ys) ~z    = []
+f (x:x1:x2:x3)	~(y,ys)  z     = []
+f x		y        True  = []

testsuite/tests/ghc-regress/deSugar/should_compile/ds003.stderr

+
+ds003.hs:5: Warning: Pattern match(es) are overlapped in the definition of function `f':
+	    f (x : (x1 : (x2 : x3))) ~(y, ys) z = ...
+	    f x y True = ...

testsuite/tests/ghc-regress/deSugar/should_compile/ds004.hs

+-- !!! ds004 -- nodups from SLPJ p 79
+--
+module ShouldCompile where
+
+-- SLPJ, p 79
+nodups []                   = []
+nodups [x]                  = [x]
+nodups (y:x:xs) | y == x    = nodups (x:xs)
+    	    	| True	    = y : nodups (x:xs)

testsuite/tests/ghc-regress/deSugar/should_compile/ds005.hs

+-- !!! ds005 -- mappairs from SLPJ Ch 5'
+--
+-- this simply tests a "typical" example
+
+module ShouldCompile where
+
+-- from SLPJ, p 78
+mappairs f []     ys     = []
+mappairs f (x:xs) []     = []
+mappairs f (x:xs) (y:ys) = f x y : mappairs f xs ys
+
+-- from p 80
+mappairs' f []     ys     = []
+mappairs' f x      []     = []
+mappairs' f (x:xs) (y:ys) = f x y : mappairs' f xs ys

testsuite/tests/ghc-regress/deSugar/should_compile/ds006.hs

+-- !!! ds006 -- v | True = v+1 | False = v (dead code elim)
+--
+module ShouldCompile where
+
+v | True  = v + 1
+  | False = v

testsuite/tests/ghc-regress/deSugar/should_compile/ds007.hs

+-- !!! ds007 -- simple local bindings
+
+module ShouldCompile where
+
+w = a where a = y
+            y = []

testsuite/tests/ghc-regress/deSugar/should_compile/ds008.hs

+-- !!! ds008 -- free tyvars on RHSs
+--
+-- these tests involve way-cool TyApps
+
+module ShouldCompile where
+
+f x = []
+
+g x = (f [],[],[],[])
+
+h x = g (1::Int)