Skip to content
Snippets Groups Projects
Commit 97f5fc60 authored by Simon Marlow's avatar Simon Marlow
Browse files

[project @ 2000-11-03 16:23:37 by simonmar]

"make clean" in here now works as advertised.
parent 4816dbe2
No related merge requests found
Showing
with 23 additions and 22 deletions
-- !!! cc006 -- ccall with non-standard boxed arguments and results
module Test where
module ShouldCompile where
import Foreign
import CCall
......
-- !!! cc007 -- foreign import with external name equal to Haskell name.
module Test where
module ShouldCompile where
foreign import sine :: Double -> Double
-- !!! cc008 -- foreign export dynamic returning newtype of Addr
module Test where
module ShouldCompile where
import Addr
......
-- !!! cc009 -- foreign label returning newtype of Addr
module Test where
module ShouldCompile where
import Addr
......
#-----------------------------------------------------------------------------
# $Id: Makefile,v 1.14 2000/08/22 14:05:05 sewardj Exp $
# $Id: Makefile,v 1.15 2000/11/03 16:23:37 simonmar Exp $
TOP = ../..
include $(TOP)/mk/boilerplate.mk
......@@ -39,7 +39,6 @@ SRC_MKDEPENDHS_OPTS += -fglasgow-exts
.PRECIOUS: %.bin %.o
clean ::
rm -f *.bin *.o
CLEAN_FILES += PrelMain.hi
include $(TOP)/mk/target.mk
#-----------------------------------------------------------------------------
# $Id: Makefile,v 1.8 2000/06/12 17:01:57 panne Exp $
# $Id: Makefile,v 1.9 2000/11/03 16:23:37 simonmar Exp $
TOP = ../..
include $(TOP)/mk/boilerplate.mk
......@@ -16,4 +16,6 @@ conc021_RUNTEST_OPTS = -x 250
SRC_HC_OPTS += -dcore-lint -package concurrent -fglasgow-exts
CLEAN_FILES += PrelMain.hi
include $(TOP)/mk/target.mk
module ShouldSucceed where
module ShouldCompile where
x@_ = x
......@@ -2,7 +2,7 @@
--
-- this tests ultra-simple function and pattern bindings (no patterns)
module Test where
module ShouldCompile where
-- simple function bindings
......
......@@ -2,7 +2,7 @@
--
-- this tests "overlapping" variables and guards
module Test where
module ShouldCompile where
f x = x
f y = y
......
-- !!! ds003 -- list, tuple, lazy, as patterns
--
module Test where
module ShouldCompile where
f [] y True = []
f x a@(y,ys) ~z = []
......
-- !!! ds004 -- nodups from SLPJ p 79
--
module Test where
module ShouldCompile where
-- SLPJ, p 79
nodups [] = []
......
......@@ -2,7 +2,7 @@
--
-- this simply tests a "typical" example
module MapPairs where
module ShouldCompile where
-- from SLPJ, p 78
mappairs f [] ys = []
......
-- !!! ds006 -- v | True = v+1 | False = v (dead code elim)
--
module Test where
module ShouldCompile where
v | True = v + 1
| False = v
-- !!! ds007 -- simple local bindings
module ShouldSucceed where
module ShouldCompile where
w = a where a = y
y = []
......@@ -2,7 +2,7 @@
--
-- these tests involve way-cool TyApps
module Test where
module ShouldCompile where
f x = []
......
-- !!! ds009 -- simple list comprehensions
module SimpleListComp where
module ShouldCompile where
f xs = [ x | x <- xs ]
......
-- !!! ds010 -- deeply-nested list comprehensions
module Test where
module ShouldCompile where
z = [ (a,b,c,d,e,f,g,h,i,j) | a <- "12",
b <- "12",
......
-- !!! ds011 -- uses of "error"
module Tests where
module ShouldCompile where
f = error []
......
-- !!! ds012 -- simple Integer arithmetic
--
module Tests where
module ShouldCompile where
f x = 1 + 2 - 3 + 4 * 5
......
-- !!! ds013 -- simple Rational arithmetic
module Tests where
module ShouldCompile where
f = 1.5 + 2.0 - 3.14159265 + 4.2 * 5.111111111111111111111111111
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment