Commit 5bb05c27 authored by sof's avatar sof
Browse files

[project @ 1997-07-31 01:46:24 by sof]

Moved to main compiler regression test directory
parent e3b67289
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
HS_SRCS = $(wildcard *.hs)
SRC_RUNTEST_OPTS += -o1 $*.stdout -o2 $*.stderr -x 0
HC_OPTS += -dcore-lint -fglasgow-exts
cc002_RUNTEST_OPTS = -x 1
cc004_RUNTEST_OPTS = -x 1
cc007_RUNTEST_OPTS = -x 1
# 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_HC_OPTS = -noC -ddump-tc -ddump-ds
cc002_HC_OPTS = -noC -ddump-tc -ddump-ds
cc003_HC_OPTS = -noC -ddump-tc -ddump-ds
cc004_HC_OPTS = -noC -ddump-tc -ddump-ds
cc005_HC_OPTS = -fvia-C -ddump-stg -ddump-flatC
cc006_HC_OPTS = -fvia-C -ddump-stg -ddump-flatC
cc007_HC_OPTS = -fvia-C -ddump-stg -ddump-flatC
%.o : %.hs
%.o : %.hs
$(RUNTEST) $(HC) $(RUNTEST_OPTS) $(HC_OPTS) -c $< -o $@ -osuf $(subst .,,$(suffix $@))
all :: $(HS_OBJS)
include $(TOP)/mk/target.mk
--!!! cc001 -- ccall with standard boxed arguments and results
module Test where
import GlaExts
-- 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:
{- nonrec -}
{- nonrec -}
{- nonrec -}
d.Fractional_a16j =
PrelNum.$d23{-rtW,p-}
fromRational_a16o =
PrelNum.fromRational{-8T,p-}
PrelBase.Float{-3c,p-}
d.Fractional_a16j
lit_a16r =
fromRational_a16o
1.0000000000000000
d.Fractional_a16n =
PrelNum.$d14{-rtM,p-}
fromRational_a16q =
PrelNum.fromRational{-8T,p-}
PrelBase.Double{-3a,p-}
d.Fractional_a16n
lit_a16p =
fromRational_a16q
2.0000000000000000
{- nonrec -}
AbsBinds [] [] [([], c{-r5,x-}, c_a15h)]
c_a15h
x1_r4l x2_r4n x3_r4p x4_r4r
= STBase.ST{-5G,p-}{i}
[GHC.RealWorld{-3s,p-}, PrelBase.Float{-3c,p-}]
_ccall_ c
x1_r4l x2_r4n x3_r4p x4_r4r
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [([], b{-r3,x-}, b_a15F)]
b_a15F
x_r4j = STBase.ST{-5G,p-}{i}
[GHC.RealWorld{-3s,p-}, PrelBase.Int{-3g,p-}]
_ccall_ b
x_r4j
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [([], a{-r1,x-}, a_a15R)]
a_a15R
= STBase.ST{-5G,p-}{i}
[GHC.RealWorld{-3s,p-}, PrelBase.Int{-3g,p-}]
_ccall_ a
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [([], d{-r7,x-}, d_a15Y)]
d_a15Y
= STBase.thenPrimIO{-r4w,p-}
[PrelBase.Int{-3g,p-}, PrelBase.Float{-3c,p-}]
a{-r1,x-}
(\ x_r4t -> STBase.thenPrimIO{-r4w,p-}
[PrelBase.Int{-3g,p-}, PrelBase.Float{-3c,p-}]
(b{-r3,x-}
x_r4t)
(\ y_r4v -> c{-r5,x-}
y_r4v 'f' lit_a16r lit_a16p))
{- nonrec -}
================================================================================
Desugared:
Rec {
d.Fractional_a16j ::
{PrelNum.Fractional{-26,p-} PrelBase.Float{-3c,p-}}
{-# L #-}
d.Fractional_a16j =
PrelNum.$d23{-rtW,p-}
fromRational_a16o ::
PrelNum.Rational{-3r,p-} -> PrelBase.Float{-3c,p-}
{-# L #-}
fromRational_a16o =
PrelNum.fromRational{-8T,p-}
_@_ PrelBase.Float{-3c,p-} d.Fractional_a16j
lit_a16r ::
PrelBase.Float{-3c,p-}
{-# L #-}
lit_a16r =
fromRational_a16o
_rational_ 1 1
d.Fractional_a16n ::
{PrelNum.Fractional{-26,p-} PrelBase.Double{-3a,p-}}
{-# L #-}
d.Fractional_a16n =
PrelNum.$d14{-rtM,p-}
fromRational_a16q ::
PrelNum.Rational{-3r,p-} -> PrelBase.Double{-3a,p-}
{-# L #-}
fromRational_a16q =
PrelNum.fromRational{-8T,p-}
_@_ PrelBase.Double{-3a,p-} d.Fractional_a16n
lit_a16p ::
PrelBase.Double{-3a,p-}
{-# L #-}
lit_a16p =
fromRational_a16q
_rational_ 2 1
c_a15h ::
PrelBase.Int{-3g,p-}
-> PrelBase.Char{-38,p-}
-> PrelBase.Float{-3c,p-}
-> PrelBase.Double{-3a,p-}
-> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
{-# L #-}
c_a15h =
\ x1_r4l ::
PrelBase.Int{-3g,p-}
{-# L #-}
x1_r4l x2_r4n ::
PrelBase.Char{-38,p-}
{-# L #-}
x2_r4n x3_r4p ::
PrelBase.Float{-3c,p-}
{-# L #-}
x3_r4p x4_r4r ::
PrelBase.Double{-3a,p-}
{-# L #-}
x4_r4r ->
let {
ds_d1et ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
-> (PrelBase.Float{-3c,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
{-# L #-}
ds_d1et =
\ ds_d1ez ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d1ez ->
case ds_d1ez of { STBase.S#{-5D,p-}{i} ds_d1eI ->
case x1_r4l of { PrelBase.I#{-5b,p-}{i} ds_d1eR ->
case x2_r4n of { PrelBase.C#{-54,p-}{i} ds_d1f0 ->
case x3_r4p of { PrelBase.F#{-59,p-}{i} ds_d1f9 ->
case x4_r4r of { PrelBase.D#{-56,p-}{i} ds_d1fw ->
case
_ccall_ c [(STBase.StateAndFloat#{-3C,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-} GHC.Char#{-37,p-} GHC.Float#{-3b,p-} GHC.Double#{-39,p-}]!
ds_d1eI ds_d1eR ds_d1f0 ds_d1f9 ds_d1fw
of {
STBase.StateAndFloat#{-5u,p-}{i} ds_d1fZ ds_d1fX ->
let {
ds_d1fO ::
PrelBase.Float{-3c,p-}
{-# L #-}
ds_d1fO =
PrelBase.F#{-59,p-}{i}
{ds_d1fX} } in
let {
ds_d1fS ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d1fS =
STBase.S#{-5D,p-}{i}
{_@_ GHC.RealWorld{-3s,p-} ds_d1fZ}
} in
PrelTup.(,){-62,p-}{i}
{_@_ PrelBase.Float{-3c,p-}
_@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
ds_d1fO
ds_d1fS};};};};};};}
} in
STBase.ST{-5G,p-}{i}
_@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Float{-3c,p-} ds_d1et
c{-r5,x-} ::
PrelBase.Int{-3g,p-}
-> PrelBase.Char{-38,p-}
-> PrelBase.Float{-3c,p-}
-> PrelBase.Double{-3a,p-}
-> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
{-# L #-}
c{-r5,x-} =
c_a15h
b_a15F ::
PrelBase.Int{-3g,p-} -> STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
b_a15F =
\ x_r4j ::
PrelBase.Int{-3g,p-}
{-# L #-}
x_r4j ->
let {
ds_d1gj ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
-> (PrelBase.Int{-3g,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
{-# L #-}
ds_d1gj =
\ ds_d1gp ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d1gp ->
case ds_d1gp of { STBase.S#{-5D,p-}{i} ds_d1gy ->
case x_r4j of { PrelBase.I#{-5b,p-}{i} ds_d1gM ->
case
_ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-}) GHC.Int#{-3f,p-}]!
ds_d1gy ds_d1gM
of {
STBase.StateAndInt#{-5v,p-}{i} ds_d1hf ds_d1hd ->
let {
ds_d1h4 ::
PrelBase.Int{-3g,p-}
{-# L #-}
ds_d1h4 =
PrelBase.I#{-5b,p-}{i}
{ds_d1hd} } in
let {
ds_d1h8 ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d1h8 =
STBase.S#{-5D,p-}{i}
{_@_ GHC.RealWorld{-3s,p-} ds_d1hf}
} in
PrelTup.(,){-62,p-}{i}
{_@_ PrelBase.Int{-3g,p-}
_@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
ds_d1h4
ds_d1h8};};};}
} in
STBase.ST{-5G,p-}{i}
_@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Int{-3g,p-} ds_d1gj
b{-r3,x-} ::
PrelBase.Int{-3g,p-} -> STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
b{-r3,x-} =
b_a15F
a_a15R ::
STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
a_a15R =
let {
ds_d1hy ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
-> (PrelBase.Int{-3g,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
{-# L #-}
ds_d1hy =
\ ds_d1hE ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d1hE ->
case ds_d1hE of { STBase.S#{-5D,p-}{i} ds_d1hP ->
case
_ccall_ a [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]!
ds_d1hP
of {
STBase.StateAndInt#{-5v,p-}{i} ds_d1ii ds_d1ig ->
let {
ds_d1i7 ::
PrelBase.Int{-3g,p-}
{-# L #-}
ds_d1i7 =
PrelBase.I#{-5b,p-}{i}
{ds_d1ig} } in
let {
ds_d1ib ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d1ib =
STBase.S#{-5D,p-}{i}
{_@_ GHC.RealWorld{-3s,p-} ds_d1ii}
} in
PrelTup.(,){-62,p-}{i}
{_@_ PrelBase.Int{-3g,p-}
_@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
ds_d1i7
ds_d1ib};};}
} in
STBase.ST{-5G,p-}{i}
_@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Int{-3g,p-} ds_d1hy
a{-r1,x-} ::
STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
a{-r1,x-} =
a_a15R
d_a15Y ::
STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
{-# L #-}
d_a15Y =
let {
ds_d1iE ::
PrelBase.Int{-3g,p-}
-> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
{-# L #-}
ds_d1iE =
\ x_r4t ::
PrelBase.Int{-3g,p-}
{-# L #-}
x_r4t ->
let {
ds_d1iT ::
STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
ds_d1iT =
b{-r3,x-}
x_r4t } in
let {
ds_d1iX ::
PrelBase.Int{-3g,p-}
-> STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
{-# L #-}
ds_d1iX =
\ y_r4v ::
PrelBase.Int{-3g,p-}
{-# L #-}
y_r4v ->
let {
ds_d1jf ::
PrelBase.Char{-38,p-}
{-# L #-}
ds_d1jf =
PrelBase.C#{-54,p-}{i}
{'f'}
} in
c{-r5,x-}
y_r4v ds_d1jf lit_a16r lit_a16p
} in
STBase.thenPrimIO{-r4w,p-}
_@_ PrelBase.Int{-3g,p-} _@_ PrelBase.Float{-3c,p-} ds_d1iT ds_d1iX
} in
STBase.thenPrimIO{-r4w,p-}
_@_ PrelBase.Int{-3g,p-}
_@_ PrelBase.Float{-3c,p-}
a{-r1,x-}
ds_d1iE
d{-r7,x-} ::
STBase.PrimIO{-3P,p-} PrelBase.Float{-3c,p-}
{-# L #-}
d{-r7,x-} =
d_a15Y
end Rec }
NOTE: Simplifier still going after 4 iterations; bailing out.
--!!! cc002 -- ccall with non-standard boxed arguments and results
module Test where
import GlaExts
import Foreign
-- Test returning results
a :: PrimIO ForeignObj
a = _ccall_ a
b :: PrimIO (StablePtr Double)
b = _ccall_ b
-- Test taking arguments
c :: ForeignObj -> PrimIO Int
c x = _ccall_ c x
d :: StablePtr Int -> PrimIO Int
d x = _ccall_ d x
cc002.hs:11: No instance for:
`Foreign.CReturnable Foreign.ForeignObj'
cc002.hs:11:
in the result of the _ccall_ to a
When checking signature(s) for: `a'
Compilation had errors
--!!! cc003 -- ccall with unresolved polymorphism (should fail)
--!!! not anymore (as of 0.29, result type will default to ())
module Test where
import GlaExts
fubar :: PrimIO Int
fubar = _ccall_ f `seqPrimIO` _ccall_ b
--^ result type of f "lost" (never gets generalised)
================================================================================
Typechecked:
{- nonrec -}
{- nonrec -}
AbsBinds [] [] [([], fubar{-r1,x-}, fubar_aZa)]
fubar_aZa
= STBase.seqPrimIO{-r46,p-}
[PrelBase.(){-40,p-}, PrelBase.Int{-3g,p-}]
(STBase.ST{-5G,p-}{i}
[GHC.RealWorld{-3s,p-}, PrelBase.(){-40,p-}]
_ccall_ f)
(STBase.ST{-5G,p-}{i}
[GHC.RealWorld{-3s,p-}, PrelBase.Int{-3g,p-}]
_ccall_ b)
{- nonrec -}
================================================================================
Desugared:
fubar_aZa ::
STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
fubar_aZa =
let { ds_d110 ::
STBase.ST{-3O,p-} GHC.RealWorld{-3s,p-} PrelBase.(){-40,p-}
{-# L #-}
ds_d110 =
let {
ds_d11g ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
-> (PrelBase.(){-40,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
{-# L #-}
ds_d11g =
\ ds_d11m ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d11m ->
case ds_d11m of { STBase.S#{-5D,p-}{i} ds_d11x ->
case
_ccall_ f [(STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]!
ds_d11x
of {
STBase.S#{-5D,p-}{i} ds_d11X ->
let {
ds_d11Q ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d11Q =
STBase.S#{-5D,p-}{i}
{_@_ GHC.RealWorld{-3s,p-} ds_d11X}
} in
PrelTup.(,){-62,p-}{i}
{_@_ PrelBase.(){-40,p-}
_@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
PrelBase.(){-60,p-}{i}
ds_d11Q};};}
} in
STBase.ST{-5G,p-}{i}
_@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.(){-40,p-} ds_d11g
} in
let { ds_d114 ::
STBase.ST{-3O,p-} GHC.RealWorld{-3s,p-} PrelBase.Int{-3g,p-}
{-# L #-}
ds_d114 =
let {
ds_d12a ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
-> (PrelBase.Int{-3g,p-}, STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
{-# L #-}
ds_d12a =
\ ds_d12g ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d12g ->
case ds_d12g of { STBase.S#{-5D,p-}{i} ds_d12r ->
case
_ccall_ b [(STBase.StateAndInt#{-3D,p-} GHC.RealWorld{-3s,p-}) (GHC.State#{-3L,p-} GHC.RealWorld{-3s,p-})]!
ds_d12r
of {
STBase.StateAndInt#{-5v,p-}{i} ds_d12U ds_d12S ->
let {
ds_d12J ::
PrelBase.Int{-3g,p-}
{-# L #-}
ds_d12J =
PrelBase.I#{-5b,p-}{i}
{ds_d12S} } in
let {
ds_d12N ::
STBase.State{-3M,p-} GHC.RealWorld{-3s,p-}
{-# L #-}
ds_d12N =
STBase.S#{-5D,p-}{i}
{_@_ GHC.RealWorld{-3s,p-} ds_d12U}
} in
PrelTup.(,){-62,p-}{i}
{_@_ PrelBase.Int{-3g,p-}
_@_ (STBase.State{-3M,p-} GHC.RealWorld{-3s,p-})
ds_d12J
ds_d12N};};}
} in
STBase.ST{-5G,p-}{i}
_@_ GHC.RealWorld{-3s,p-} _@_ PrelBase.Int{-3g,p-} ds_d12a
} in
STBase.seqPrimIO{-r46,p-}
_@_ PrelBase.(){-40,p-} _@_ PrelBase.Int{-3g,p-} ds_d110 ds_d114
fubar{-r1,x-} ::
STBase.PrimIO{-3P,p-} PrelBase.Int{-3g,p-}
{-# L #-}
fubar{-r1,x-} =
fubar_aZa
NOTE: Simplifier still going after 4 iterations; bailing out.
--!!! cc004 -- ccall with synonyms, polymorphic type variables and user type variables.
module Test where
import GlaExts
-- 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
thenADR = thenPrimIO
-- 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
thenADR = thenPrimIO
-- and with a type synonym
type INT = Int
barfu :: PrimIO INT
barfu = _ccall_ b
cc004.hs:2: Cannot generalise these overloadings (in a _ccall_):
`Foreign.CReturnable t{-a12p-}'
cc004.hs:2: Cannot generalise these overloadings (in a _ccall_):
`Foreign.CReturnable t{-a138-}'
Compilation had errors
--!!! cc001 -- ccall with standard boxed arguments and results
module Test where
import GlaExts
-- 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
This diff is collapsed.
--!!! cc006 -- ccall with non-standard boxed arguments and results
module Test where
import GlaExts
import Foreign
-- Test returning results