Commit 334e7e63 authored by dnt's avatar dnt
Browse files

[project @ 1996-11-26 12:46:28 by dnt]

Merged in changes from new-build-system branch
parent a39b38ff
#define IHaveSubdirs
SUBDIRS = reader \
rename \
simplCore \
typecheck \
deSugar \
printing \
ccall \
deriving
TOP = ../../..
include $(TOP)/ghc/mk/ghc.mk
SUBDIRS = reader rename simplCore typecheck deSugar printing ccall deriving
include $(TOP)/mk/subdir.mk
Installing a new compiler test
==============================
-------------------------------------------------------------------------------
GHC COMPILER TESTS
-------------------------------------------------------------------------------
[If the test if for the driver, the parser, the runtime system, the
std prelude, ... in short _not_ the compiler, it belongs elsewhere.]
This directory contains tests for various bits of the internals of ghc.
Note that tests for other parts of the ghc system (such as the driver,
parser, runtime system, standard prelude) belong elsewhere.
1. Copy your Haskell program into an appropriately named file in the
appropriate directory, e.g., "typecheck/tc093.hs" for the 93rd
typechecker test.
Each test takes the form of a single program (for example, reader001.hs)
and a files which specify ghc's expected error output (reader001.stderr).
2. Edit the Jmakefile in that dir to add your test: almost certainly
just a line of the form...
"make reader001.runtest" will compile reader001.hs using ghc and compare
the resulting output with that specified in the file reader001.stderr.
RunStdTest(tc093,$(TESTGHC), "-ddump-tc tc093.hs", 0, /dev/null, tc093.stderr)
^^^^^
name of test||||
^^^^^^^^^^
driver to use----||||||||||
^^^^^^^^^^^^^^^^^^^^
driver command line----------||||||||||||||||||||
^^
expected exit status (0=success, 1=failure)-------||
^^^^^^^^^
file holding expected standard output----------------|||||||||
^^^^^^^^^^^^^
file holding expected output on standard error------------------|||||||||||||
"make runtests" run all tests.
The example above is typical. The command-line stuff may vary,
but it's likely to be "dump pass <foo> output" (e.g., -ddump-tc)
and the input file name. Dump output is on stderr, hence the
expected-output files.
-------------------------------------------------------------------------------
ADDING A NEW TEST
-------------------------------------------------------------------------------
The current best documentation of the flags to use is in
$(TOP)/driver/ghc (invoke w/ -help option).
To add a new test copy your Haskell program into an appropriately named
file in the appropriate directory (for example, "typecheck/tc093.hs" for
the 93rd typechecker test).
3. Create the expected-output files. I'm usually lazy and just
"touch" them (creating an empty file), then update them (section
below) after the test has "failed".
Edit the Makefile in that directory to add your test. Most directories
have some flags which are set for every test (RUNSTDTEST_OPTS), but you can
also set some extra per-file runtest flags (to control the output of ghc,
for instance). Just set ttc093_flags to the flags you want.
4. "make Makefile", to make a Makefile from the Jmakefile.
For example,
5. "make runtest_<testname>" (e.g., make runtest_tc093) to run the
one test.
tc093_flags = -noC -ddump-tc -x1
IF "make" FALLS OVER, THEN IMMEDIATEDLY "mv Makefile.bak Makefile"!!
You probably had a typo in the Jmakefile; fix it and resume from
step 4.
-noC tells not bother generating any C (not point in doing that, since we
only want to test the typechecker). -ddump-tc tells ghc to dump the
typechcker state, while -x1 tells runtest that the expected exit code is 1,
not 0 (the default).
Running tests
=============
* You may run all tests by typing "make runtests" (or, if you expect
or don't mind errors, "make -k runtests").
* You may run one test <foo> with "make runtest_<foo>".
* You may run tests <foo> to <bar> with a simple script,
"dotests <foo> <bar>". You may pass "make" arguments to it as well,
as in:
dotests -k tc019 tc028
Updating the "expected output" files
====================================
Sometimes, it will happen that the differences between expected and
actual output of the tests will not mean failure but that the actual
output is "more correct".
If you save the output of "make runtests" (mainly from "diff"), you
may automatically update the expected-output files by using
patch -p0 < saved-output
(You should probably ^C out of the "patch" if it doesn't do exactly
what you expect.)
"touch" the file tc093.stderr. "make tc093.runtest" will then build
tc093.runtest and fail (because the expected output doesn't match the empty
tc093.stderr). However, it is then easy to update tc093.stderr with the
stuff printed out during "make tc093.runtest".
runtests::
@echo '###############################################################'
@echo '# Validation tests for the ccall desugaring, etc. #'
@echo '###############################################################'
/* NB These tests are still in a state of flux... don't believe errors
they report. In fact, these aren't really very good tests at
all... */
/* Flags used when testing typechecker and desugaring */
DS_FLAGS= -fglasgow-exts -noC -dcore-lint -ddump-tc -ddump-ds
RunStdTest(cc001,$(GHC), $(DS_FLAGS) cc001.hs -o2 cc001.stderr)
RunStdTest(cc002,$(GHC), $(DS_FLAGS) cc002.hs -o2 cc002.stderr)
RunStdTest(cc003,$(GHC), $(DS_FLAGS) cc003.hs -x1 -o2 cc003.stderr)
RunStdTest(cc004,$(GHC), $(DS_FLAGS) cc004.hs -o2 cc004.stderr)
/* Flags used when testing code generation */
CG_FLAGS= -fglasgow-exts -via-C -dcore-lint -ddump-stg -ddump-flatC
TOP = ../../../..
GhcRunTestRules = YES
# These options apply to all tests
RUNSTDTEST_OPTS = -fglasgow-exts -dcore-lint
include $(TOP)/ghc/mk/ghc.mk
runtests :: $(patsubst %.hs, %.runtest, $(wildcard *.hs))
# Note that these tests are still in a state of flux... don't believe errors
# they report. In fact, these aren't really very good tests at all...
cc001_flags = -noC -ddump-tc -ddump-ds
cc002_flags = -noC -ddump-tc -ddump-ds
cc003_flags = -noC -ddump-tc -ddump-ds -x1
cc004_flags = -noC -ddump-tc -ddump-ds
cc005_flags = -via-C -ddump-stg -ddump-flatC
cc006_flags = -via-C -ddump-stg -ddump-flatC
cc007_flags = -via-C -ddump-stg -ddump-flatC
--!!! cc001 -- ccall with standard boxed arguments and results
module Test where
import PreludeGlaST
-- simple functions
a :: PrimIO Int
a = _ccall_ a
b :: Int -> PrimIO Int
b x = _ccall_ b x
c :: Int -> Char -> Float -> Double -> PrimIO Float
c x1 x2 x3 x4 = _ccall_ c x1 x2 x3 x4
-- simple monadic code
d = a `thenPrimIO` \ x ->
b x `thenPrimIO` \ y ->
c y 'f' 1.0 2.0
Typechecked:
lit.t444 = D# 2.0000000000000000##
lit.t443 = F# 1.0000000000000000#
AbsBinds [] [] [(a.t439, Test.a{-r79-})]
{- nonrec -}
a.t439 :: IoWorld -> (Int, IoWorld)
a.t439
= ccall a [Int]
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [(b.t440, Test.b{-r80-})]
{- nonrec -}
b.t440 :: Int -> IoWorld -> (Int, IoWorld)
b.t440
x.r212 = ccall b [Int, Int] x.r212
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [(c.t441, Test.c{-r81-})]
{- nonrec -}
c.t441 :: Int -> Char -> Float -> Double -> IoWorld -> (Float, IoWorld)
c.t441
x1.r213 x2.r214 x3.r215 x4.r216
= ccall c [Float, Int, Char, Float, Double]
x1.r213 x2.r214 x3.r215 x4.r216
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [(d.t442, Test.d{-r82-})]
{- nonrec -}
d.t442 :: IoWorld -> (Float, IoWorld)
d.t442
= (thenIO{-r102-} [Int, Float])
Test.a{-r79-}
(\ x.r217 -> (thenIO{-r102-} [Int, Float])
(Test.b{-r80-} x.r217)
(\ y.r218 -> Test.c{-r81-}
y.r218 'f' lit.t443 lit.t444))
{- nonrec -}
{- nonrec -}
Desugared:
{- plain CoRec -}
lit.t444 :: Double
_NI_
lit.t444 = (\ tpl.d0# -> D#! tpl.d0#) 2.0000000000000000##
lit.t443 :: Float
_NI_
lit.t443 = (\ tpl.d1# -> F#! tpl.d1#) 1.0000000000000000#
Test.a{-r79-} :: IoWorld -> (Int, IoWorld)
_NI_
Test.a{-r79-} =
\ ds.d2 ->
case
(case
(case ds.d2 of {
IoWorld ds.d3# -> ds.d3#
})
of {
a.d8# -> ( _CCALL_ a [] Int# )! a.d8#
})
of {
IntPrimAndIoWorld ds.d4# ds.d5# ->
let {
a.d6 :: Int
_NI_
a.d6 = I#! ds.d4# } in
let {
a.d7 :: IoWorld
_NI_
a.d7 = IoWorld! ds.d5#
} in Tup2! Int IoWorld a.d6 a.d7
}
Test.b{-r80-} :: Int -> IoWorld -> (Int, IoWorld)
_NI_
Test.b{-r80-} =
\ x.r212 ds.d9 ->
case
(case
(case ds.d9 of {
IoWorld ds.d10# -> ds.d10#
})
of {
a.d16# ->
case
(case x.r212 of {
I# ds.d11# -> ds.d11#
})
of {
a.d17# -> ( _CCALL_ b [Int#] Int# )! a.d16# a.d17#
}
})
of {
IntPrimAndIoWorld ds.d12# ds.d13# ->
let {
a.d14 :: Int
_NI_
a.d14 = I#! ds.d12# } in
let {
a.d15 :: IoWorld
_NI_
a.d15 = IoWorld! ds.d13#
} in Tup2! Int IoWorld a.d14 a.d15
}
Test.c{-r81-} :: Int -> Char -> Float -> Double -> IoWorld -> (Float, IoWorld)
_NI_
Test.c{-r81-} =
\ x1.r213 x2.r214 x3.r215 x4.r216 ds.d18 ->
case
(case
(case ds.d18 of {
IoWorld ds.d19# -> ds.d19#
})
of {
a.d28# ->
case
(case x1.r213 of {
I# ds.d20# -> ds.d20#
})
of {
a.d29# ->
case
(case x2.r214 of {
C# ds.d21# -> ds.d21#
})
of {
a.d30# ->
case
(case x3.r215 of {
F# ds.d22# -> ds.d22#
})
of {
a.d31# ->
case
(case x4.r216 of {
D# ds.d23# -> ds.d23#
})
of {
a.d32# ->
( _CCALL_ c [Int#,
Char#,
Float#,
Double#] Float# )!
a.d28#
a.d29#
a.d30#
a.d31#
a.d32#
}
}
}
}
})
of {
FloatPrimAndIoWorld ds.d24# ds.d25# ->
let {
a.d26 :: Float
_NI_
a.d26 = F#! ds.d24# } in
let {
a.d27 :: IoWorld
_NI_
a.d27 = IoWorld! ds.d25#
} in Tup2! Float IoWorld a.d26 a.d27
}
Test.d{-r82-} :: IoWorld -> (Float, IoWorld)
_NI_
Test.d{-r82-} =
let {
a.d36 :: Int -> IoWorld -> (Float, IoWorld)
_NI_
a.d36 =
\ x.r217 ->
let {
a.d35 :: Int -> IoWorld -> (Float, IoWorld)
_NI_
a.d35 =
\ y.r218 ->
(let {
a.d33 :: Char
_NI_
a.d33 = C#! 'f'#
} in Test.c{-r81-} y.r218 a.d33) lit.t443 lit.t444
} in
(let {
a.d34 :: IoWorld -> (Int, IoWorld)
_NI_
a.d34 = Test.b{-r80-} x.r217
} in ((thenIO{-r102-} Int) Float) a.d34) a.d35
} in ((thenIO{-r102-} Int) Float) Test.a{-r79-} a.d36
{- end plain CoRec -}
--!!! cc002 -- ccall with non-standard boxed arguments and results
module Test where
import PreludeGlaST
-- Test returning results
a :: PrimIO ForeignObj
a = _ccall_ a
b :: PrimIO StablePtr
b = _ccall_ b
-- Test taking arguments
c :: ForeignObj -> PrimIO Int
c x = _ccall_ c x
d :: StablePtr -> PrimIO Int
d x = _ccall_ d x
Typechecked:
AbsBinds [] [] [(a.t439, Test.a{-r79-})]
{- nonrec -}
a.t439 :: IoWorld -> (CHeapPtr, IoWorld)
a.t439
= ccall a [CHeapPtr]
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [(b.t440, Test.b{-r80-})]
{- nonrec -}
b.t440 :: IoWorld -> (StablePtr, IoWorld)
b.t440
= ccall b [StablePtr]
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [(c.t441, Test.c{-r81-})]
{- nonrec -}
c.t441 :: CHeapPtr -> IoWorld -> (Int, IoWorld)
c.t441
x.r211 = ccall c [Int, CHeapPtr] x.r211
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [(d.t442, Test.d{-r82-})]
{- nonrec -}
d.t442 :: StablePtr -> IoWorld -> (Int, IoWorld)
d.t442
x.r212 = ccall d [Int, StablePtr] x.r212
{- nonrec -}
{- nonrec -}
Desugared:
Test.a{-r79-} :: IoWorld -> (CHeapPtr, IoWorld)
_NI_
Test.a{-r79-} =
\ ds.d0 ->
case
(case
(case ds.d0 of {
IoWorld ds.d1# -> ds.d1#
})
of {
a.d6# -> ( _CCALL_ a [] CHeapPtr# )! a.d6#
})
of {
CHPPrimAndIoWorld ds.d2# ds.d3# ->
let {
a.d4 :: CHeapPtr
_NI_
a.d4 = CHP#! ds.d2# } in
let {
a.d5 :: IoWorld
_NI_
a.d5 = IoWorld! ds.d3#
} in Tup2! CHeapPtr IoWorld a.d4 a.d5
}
Test.b{-r80-} :: IoWorld -> (StablePtr, IoWorld)
_NI_
Test.b{-r80-} =
\ ds.d7 ->
case
(case
(case ds.d7 of {
IoWorld ds.d8# -> ds.d8#
})
of {
a.d13# -> ( _CCALL_ b [] StablePtr# )! a.d13#
})
of {
SPPrimAndIoWorld ds.d9# ds.d10# ->
let {
a.d11 :: StablePtr
_NI_
a.d11 = StablePtr#! ds.d9# } in
let {
a.d12 :: IoWorld
_NI_
a.d12 = IoWorld! ds.d10#
} in Tup2! StablePtr IoWorld a.d11 a.d12
}
Test.c{-r81-} :: CHeapPtr -> IoWorld -> (Int, IoWorld)
_NI_
Test.c{-r81-} =
\ x.r211 ds.d14 ->
case
(case
(case ds.d14 of {
IoWorld ds.d15# -> ds.d15#
})
of {
a.d21# ->
case
(case x.r211 of {
CHP# ds.d16# -> ds.d16#
})
of {
a.d22# -> ( _CCALL_ c [CHeapPtr#] Int# )! a.d21# a.d22#
}
})
of {
IntPrimAndIoWorld ds.d17# ds.d18# ->
let {
a.d19 :: Int
_NI_
a.d19 = I#! ds.d17# } in
let {
a.d20 :: IoWorld
_NI_
a.d20 = IoWorld! ds.d18#
} in Tup2! Int IoWorld a.d19 a.d20
}
Test.d{-r82-} :: StablePtr -> IoWorld -> (Int, IoWorld)
_NI_
Test.d{-r82-} =
\ x.r212 ds.d23 ->
case
(case
(case ds.d23 of {
IoWorld ds.d24# -> ds.d24#
})
of {
a.d30# ->
case
(case x.r212 of {
StablePtr# ds.d25# -> ds.d25#
})
of {
a.d31# -> ( _CCALL_ d [StablePtr#] Int# )! a.d30# a.d31#
}
})
of {
IntPrimAndIoWorld ds.d26# ds.d27# ->
let {
a.d28 :: Int
_NI_
a.d28 = I#! ds.d26# } in
let {
a.d29 :: IoWorld
_NI_
a.d29 = IoWorld! ds.d27#
} in Tup2! Int IoWorld a.d28 a.d29
}
--!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
module Test where
import PreludeGlaST
-- Since I messed up the handling of polymorphism originally, I'll
-- explicitly test code with UserSysTyVar (ie an explicit polymorphic
-- signature)
foo = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1)
where
thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
m `thenADR` k = \ s -> case m s of
(a,t) -> k a t
-- and with a PolySysTyVar (ie no explicit signature)
bar = _ccall_ f `thenADR` \ a -> returnPrimIO (a + 1)
where
-- thenADR :: PrimIO a -> (a -> PrimIO b) -> PrimIO b
m `thenADR` k = \ s -> case m s of
(a,t) -> k a t
-- and with a type synonym
type INT = Int
barfu :: PrimIO INT
barfu = _ccall_ b
#define IHaveSubdirs
SUBDIRS = cvh-ds-unboxed
runtests::
@echo '###############################################################'
@echo '# Validation tests for the desugarer. #'
@echo '###############################################################'
FLAGS=-noC -ddump-ds -dcore-lint
RunStdTest(ds001,$(GHC), $(FLAGS) ds001.hs -o2 ds001.stderr)
RunStdTest(ds002,$(GHC), $(FLAGS) ds002.hs -o2 ds002.stderr)
RunStdTest(ds003,$(GHC), $(FLAGS) ds003.hs -o2 ds003.stderr)
RunStdTest(ds004,$(GHC), $(FLAGS) ds004.hs -o2 ds004.stderr)
RunStdTest(ds005,$(GHC), $(FLAGS) ds005.hs -o2 ds005.stderr)
RunStdTest(ds006,$(GHC), $(FLAGS) ds006.hs -o2 ds006.stderr)
RunStdTest(ds007,$(GHC), $(FLAGS) ds007.hs -o2 ds007.stderr)
RunStdTest(ds008,$(GHC), $(FLAGS) ds008.hs -o2 ds008.stderr)
RunStdTest(ds009,$(GHC), $(FLAGS) ds009.hs -o2 ds009.stderr)
RunStdTest(ds010,$(GHC), $(FLAGS) ds010.hs -o2 ds010.stderr)
RunStdTest(ds011,$(GHC), $(FLAGS) ds011.hs -o2 ds011.stderr)
RunStdTest(ds012,$(GHC), $(FLAGS) ds012.hs -o2 ds012.stderr)
RunStdTest(ds013,$(GHC), $(FLAGS) ds013.hs -o2 ds013.stderr)
RunStdTest(ds014,$(GHC), $(FLAGS) ds014.hs -o2 ds014.stderr)
AsPartOfTest(ds014,@echo 'ds014a -- some things that should NOT go through -- not done yet')
RunStdTest(ds015,$(GHC), $(FLAGS) ds015.hs -o2 ds015.stderr)
RunStdTest(ds016,$(GHC), $(FLAGS) ds016.hs -o2 ds016.stderr)
RunStdTest(ds017,$(GHC), $(FLAGS) ds017.hs -o2 ds017.stderr)
RunStdTest(ds018,$(GHC), $(FLAGS) ds018.hs -o2 ds018.stderr)
RunStdTest(ds019,$(GHC), $(FLAGS) ds019.hs -o2 ds019.stderr)
RunStdTest(ds020,$(GHC), $(FLAGS) ds020.hs -o2 ds020.stderr)
RunStdTest(ds021,$(GHC), $(FLAGS) ds021.hs -o2 ds021.stderr)
RunStdTest(ds022,$(GHC), $(FLAGS) ds022.hs -o2 ds022.stderr)
RunStdTest(ds023,$(GHC), $(FLAGS) ds023.hs -o2 ds023.stderr)
RunStdTest(ds024,$(GHC), $(FLAGS) ds024.hs -o2 ds024.stderr)
RunStdTest(ds025,$(GHC), $(FLAGS) ds025.hs -o2 ds025.stderr)
RunStdTest(ds026,$(GHC), $(FLAGS) ds026.hs -o2 ds026.stderr)
RunStdTest(ds027,$(GHC), $(FLAGS) ds027.hs -o2 ds027.stderr)
RunStdTest(ds028,$(GHC), $(FLAGS) ds028.hs -o2 ds028.stderr)
RunStdTest(ds029,$(GHC), $(FLAGS) ds029.hs -o2 ds029.stderr)
RunStdTest(ds030,$(GHC), $(FLAGS) ds030.hs -dppr-all -o2 ds030.stderr)
RunStdTest(ds031,$(GHC), $(FLAGS) ds031.hs -o2 ds031.stderr)
RunStdTest(ds032,$(GHC), $(FLAGS) ds032.hs -o2 ds032.stderr)
RunStdTest(ds033,$(GHC), $(FLAGS) ds033.hs -o2 ds033.stderr)
RunStdTest(ds034,$(GHC), $(FLAGS) ds034.hs -o2 ds034.stderr)
RunStdTest(ds035,$(GHC), -fglasgow-exts $(FLAGS) ds035.hs -o2 ds035.stderr)
RunStdTest(ds036,$(GHC), $(FLAGS) ds036.hs -o2 ds036.stderr)
RunStdTest(ds037,$(GHC), $(FLAGS) ds037.hs -o2 ds037.stderr)
RunStdTest(ds038,$(GHC), $(FLAGS) ds038.hs -o2 ds038.stderr)
RunStdTest(ds039,$(GHC), $(FLAGS) -dppr-all ds039.hs -o2 ds039.stderr)
RunStdTest(ds040,$(GHC), $(FLAGS) ds040.hs -o2 ds040.stderr)