Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
f888eb87
Commit
f888eb87
authored
Jun 20, 2001
by
sewardj
Browse files
[project @ 20010620 15:57:19 by sewardj]
Hey! This game is easy.
parent
5cef8976
Changes
27
Hide whitespace changes
Inline
Sidebyside
testsuite/tests/ghcregress/typecheck/should_run/all.T
0 → 100644
View file @
f888eb87
include
(
$confdir
++
"
/../vanillatest.T
")

Args
to
vt
are:
extra
compile
flags

extra
run
flags

expected
process
return
value
,
if
not
zero
test
"
tcrun001
"
{
vt
("",
"",
"")
}
test
"
tcrun002
"
{
vt
("",
"",
"")
}
test
"
tcrun003
"
{
vt
("
fglasgowexts
",
"",
"")
}
test
"
tcrun004
"
{
vt
("
fglasgowexts
",
"",
"")
}
test
"
tcrun005
"
{
vt
("",
"",
"")
}
test
"
tcrun006
"
{
vt
("",
"",
"")
}
test
"
tcrun007
"
{
vt
("",
"",
"")
}
test
"
tcrun008
"
{
vt
("",
"",
"")
}
test
"
tcrun009
"
{
vt
("",
"",
"")
}
test
"
tcrun010
"
{
vt
("",
"",
"")
}
test
"
tcrun011
"
{
vt
("",
"",
"")
}
test
"
tcrun012
"
{
vt
("",
"",
"")
}
test
"
tcrun013
"
{
vt
("",
"",
"")
}
testsuite/tests/ghcregress/typecheck/should_run/tcrun001.hs
0 → 100644
View file @
f888eb87
 !! Test for (>) instances
module
Main
where
class
Flob
k
where
twice
::
k
a
a
>
k
a
a
instance
Flob
(
>
)
where
twice
f
=
f
.
f
inc
::
Int
>
Int
inc
x
=
x
+
1
main
=
print
(
twice
inc
2
)
testsuite/tests/ghcregress/typecheck/should_run/tcrun001.stdout
0 → 100644
View file @
f888eb87
4
testsuite/tests/ghcregress/typecheck/should_run/tcrun002.hs
0 → 100644
View file @
f888eb87
 !!! space leak from overloading !!!
module
Main
where
 This program develops a space leak if sfoldl isn't compiled with some
 care. See comment about polymorphic recursion in TcMonoBinds.lhs
import
System
(
getArgs
)
import
PrelIOBase
sfoldl
::
(
a
>
Int
>
a
)
>
a
>
[
Int
]
>
a
sfoldl
f
z
[]
=
z
sfoldl
f
z
(
x
:
xs
)
=
_scc_
"sfoldl1"
(
sfoldl
f
fzx
(
fzx
`
seq
`
xs
))
where
fzx
=
_scc_
"fzx"
(
f
z
x
)
main
=
IO
(
\
s
>
case
print
(
sfoldl
(
+
)
(
0
::
Int
)
[
1
..
200000
])
of
{
IO
a
>
a
s
})
testsuite/tests/ghcregress/typecheck/should_run/tcrun002.stdout
0 → 100644
View file @
f888eb87
1474736480
testsuite/tests/ghcregress/typecheck/should_run/tcrun003.hs
0 → 100644
View file @
f888eb87
 !!! One method class from Sergey Mechveliani
 showed up problematic newtype dict rep.
module
Main
where
import
Ratio
class
MBConvertible
a
b
where
cm
::
a
>
b
>
Maybe
b
c
::
MBConvertible
a
b
=>
a
>
b
>
b
c
a
b
=
case
cm
a
b
of
Just
b'
>
b'
_
>
error
"c a b failed"
instance
MBConvertible
Int
Int
where
cm
a
_
=
Just
a
instance
(
MBConvertible
a
b
,
Integral
b
)
=>
MBConvertible
a
(
Ratio
b
)
where
cm
a
f
=
case
cm
a
(
numerator
f
)
of
Just
a'
>
Just
(
a'
%
1
)
_
>
Nothing
main
=
let
f
=
1
%
1
::
Ratio
Int
n2
=
2
::
Int
g
=
(
c
n2
f
)
+
f
in
putStr
(
shows
g
"
\n
"
)
testsuite/tests/ghcregress/typecheck/should_run/tcrun003.stdout
0 → 100644
View file @
f888eb87
3 % 1
testsuite/tests/ghcregress/typecheck/should_run/tcrun004.hs
0 → 100644
View file @
f888eb87
 !!! Tests existential data types
 Originally from Kevin Glynn
module
Main
(
main
)
where
data
Coordinate3D
=
Coord3D
{
cx
,
cy
,
cz
::
Double
}
deriving
(
Eq
,
Show
)
 We Represent a line by two coordinates which it passes through.
data
Line
=
MkLine
Coordinate3D
Coordinate3D
class
PictureObject
pot
where
 Returns ordered (rel to 0 0 0) of points where the object
 intersects the given line.
intersectLineObject
::
pot
>
Line
>
[
Coordinate3D
]
getPictureName
::
pot
>
String
data
Sphere
=
Sphere
Coordinate3D
 Centre
Double
 Radius
Double
 ambient coeff
Double
 diffuse coeff
Double
 specular coeff
Double
 phong specular exponent
intersectLineSphere
::
Sphere
>
Line
>
[
Coordinate3D
]
intersectLineSphere
sp
line
=
[]
instance
PictureObject
Sphere
where
intersectLineObject
=
intersectLineSphere
getPictureName
_
=
"Sphere"
data
Cube
=
Cube
Coordinate3D
 Origin corner
Coordinate3D
 Opposite corner
Double
 ambient coeff
Double
 diffuse coeff
Double
 specular coeff
Double
 phong specular exponent
deriving
(
Eq
,
Show
)
intersectLineCube
::
Cube
>
Line
>
[
Coordinate3D
]
intersectLineCube
cube
line
=
[]
instance
PictureObject
Cube
where
intersectLineObject
=
intersectLineCube
getPictureName
_
=
"Cube"
data
GenPic
=
forall
pot
.
(
PictureObject
pot
)
=>
MkGenPic
pot
sphere
::
Sphere
sphere
=
Sphere
(
Coord3D
1
1
1
)
1
1
1
1
1
cube
::
Cube
cube
=
Cube
(
Coord3D
1
1
1
)
(
Coord3D
2
2
2
)
1
1
1
1
obj_list
::
[
GenPic
]
obj_list
=
[
MkGenPic
sphere
,
MkGenPic
cube
]
putName
::
PictureObject
pot
=>
pot
>
IO
()
putName
x
=
putStr
$
getPictureName
x
main
::
IO
()
main
=
do
{
sequence_
$
map
put_it
obj_list
}
where
put_it
(
MkGenPic
s
)
=
putStrLn
(
getPictureName
s
)
testsuite/tests/ghcregress/typecheck/should_run/tcrun004.stdout
0 → 100644
View file @
f888eb87
Sphere
Cube
testsuite/tests/ghcregress/typecheck/should_run/tcrun005.hs
0 → 100644
View file @
f888eb87
 !!! Dfun naming bug
module
Main
where
data
TT
=
TT
data
TTT
=
TTT
class
CC
a
where
op_cc
::
a
>
a
class
CCT
a
where
op_cct
::
a
>
a
 These two instances should get different dfun names!
 In GHC 4.04 they both got $fCCTTT
instance
CC
TTT
where
op_cc
=
id
instance
CCT
TT
where
op_cct
=
id
main
=
case
op_cc
TTT
of
TTT
>
print
"ok"
testsuite/tests/ghcregress/typecheck/should_run/tcrun005.stdout
0 → 100644
View file @
f888eb87
"ok"
testsuite/tests/ghcregress/typecheck/should_run/tcrun006.hs
0 → 100644
View file @
f888eb87
 !!! Selectors for data and newtypes with contexts
 This program, reported in Aug'00 by Jose Emilio Labra Gayo
 gave rise to a Lint error because the selector 'newout' below
 was given the type
 Eq f => NewT f > f
 but lacked a dictionary argument in its body.
module
Main
where
newtype
(
Eq
f
)
=>
NewT
f
=
NewIn
{
newout
::
f
}
data
(
Eq
f
)
=>
DataT
f
=
DataIn
{
dataout
::
f
}
main
=
print
(
newout
(
NewIn
"ok new"
)
++
dataout
(
DataIn
" ok data"
))
testsuite/tests/ghcregress/typecheck/should_run/tcrun006.stdout
0 → 100644
View file @
f888eb87
"ok new ok data"
testsuite/tests/ghcregress/typecheck/should_run/tcrun007.hs
0 → 100644
View file @
f888eb87
{# OPTIONS fglasgowexts fgenerics #}
 !!! Test generics
module
Main
where
import
PrelBase
 In a real program it would be 'import Generics'
 but Generics is in package lang, so importing
 PrelBase reduces dependencies
class
Bin
a
where
toBin
::
a
>
[
Int
]
fromBin
::
[
Int
]
>
(
a
,
[
Int
])
toBin
{

Unit

}
Unit
=
[]
toBin
{

a
:+:
b

}
(
Inl
x
)
=
0
:
toBin
x
toBin
{

a
:+:
b

}
(
Inr
y
)
=
1
:
toBin
y
toBin
{

a
:*:
b

}
(
x
:*:
y
)
=
toBin
x
++
toBin
y
fromBin
{

Unit

}
bs
=
(
Unit
,
bs
)
fromBin
{

a
:+:
b

}
(
0
:
bs
)
=
(
Inl
x
,
bs'
)
where
(
x
,
bs'
)
=
fromBin
bs
fromBin
{

a
:+:
b

}
(
1
:
bs
)
=
(
Inr
y
,
bs'
)
where
(
y
,
bs'
)
=
fromBin
bs
fromBin
{

a
:*:
b

}
bs
=
(
x
:*:
y
,
bs''
)
where
(
x
,
bs'
)
=
fromBin
bs
(
y
,
bs''
)
=
fromBin
bs'
class
Tag
a
where
nCons
::
a
>
Int
nCons
{

Unit

}
_
=
1
nCons
{

a
:*:
b

}
_
=
1
nCons
{

a
:+:
b

}
_
=
nCons
(
bot
::
a
)
+
nCons
(
bot
::
b
)
tag
::
a
>
Int
tag
{

Unit

}
_
=
1
tag
{

a
:*:
b

}
_
=
1
tag
{

a
:+:
b

}
(
Inl
x
)
=
tag
x
tag
{

a
:+:
b

}
(
Inr
y
)
=
nCons
(
bot
::
a
)
+
tag
y
bot
=
bot
instance
(
Bin
a
,
Bin
b
)
=>
Bin
(
a
,
b
)
instance
Bin
a
=>
Bin
[
a
]
instance
Bin
a
=>
Bin
(
T
a
)
instance
Bin
Int
where
toBin
x
=
[
x
]
fromBin
(
x
:
xs
)
=
(
x
,
xs
)
data
T
a
=
MkT
a
(
T
a
)
(
T
a
)

Nil
deriving
Show
instance
Tag
Colour
data
Colour
=
Red

Blue

Green

Purple

White
t
::
T
Int
t
=
MkT
3
(
MkT
6
Nil
Nil
)
Nil
main
=
print
(
toBin
t
)
>>
print
((
fromBin
(
toBin
t
))
::
(
T
Int
,[
Int
]))
>>
print
(
tag
Blue
)
>>
print
(
tag
White
)
>>
print
(
nCons
Red
)
testsuite/tests/ghcregress/typecheck/should_run/tcrun007.stdout
0 → 100644
View file @
f888eb87
[0,3,0,6,1,1,1]
(MkT 3 (MkT 6 Nil Nil) Nil,[])
2
5
5
testsuite/tests/ghcregress/typecheck/should_run/tcrun008.hs
0 → 100644
View file @
f888eb87
{# OPTIONS fglasgowexts #}
 !!! Check that record selectors for polymorphic fields work right
module
Main
where
import
IO
class
Foo
a
where
bar
::
a
>
[
a
]
instance
Foo
Int
where
bar
x
=
replicate
x
x
instance
Foo
Bool
where
bar
x
=
[
x
,
not
x
]
data
Record
=
R
{
blub
::
Foo
a
=>
a
>
[
a
]
}
main
=
do
{
let
r
=
R
{
blub
=
bar
}
;
print
(
blub
r
(
3
::
Int
))
;
print
(
blub
r
True
)
}
testsuite/tests/ghcregress/typecheck/should_run/tcrun008.stdout
0 → 100644
View file @
f888eb87
[3,3,3]
[True,False]
testsuite/tests/ghcregress/typecheck/should_run/tcrun009.hs
0 → 100644
View file @
f888eb87
{# OPTIONS fglasgowexts #}
 !!! Functional dependencies
module
Main
where
class
Foo
a
b

a
>
b
where
foo
::
a
>
b
instance
Foo
[
a
]
(
Maybe
a
)
where
foo
[]
=
Nothing
foo
(
x
:
_
)
=
Just
x
instance
Foo
(
Maybe
a
)
[
a
]
where
foo
Nothing
=
[]
foo
(
Just
x
)
=
[
x
]
test3
::
[
a
]
>
[
b
]
test3
=
foo
.
foo
 First foo must use the first instance,
 second must use the second. So we should
 get in effect: test3 (x:xs) = [x]
main
::
IO
()
main
=
print
(
test3
"foo"
::
[
Int
])
testsuite/tests/ghcregress/typecheck/should_run/tcrun009.stdout
0 → 100644
View file @
f888eb87
['f']
testsuite/tests/ghcregress/typecheck/should_run/tcrun010.hs
0 → 100644
View file @
f888eb87
{# OPTIONS fglasgowexts #}
 !!! Functional dependencies
 This one gave "zonkIdOcc: FunDep_a11w" in earlier days
module
Main
(
main
)
where
data
ERR
a
b
=
EOK
a

ERR
b
deriving
(
Show
)
data
Error
=
No

Notatall
deriving
(
Show
,
Eq
)
class
MonadErr
m
e

m
>
e
where
aerturn
::
e
>
m
a
areturn
::
a
>
m
a
acatch
::
a
>
(
a
>
m
b
)
>
(
e
>
m
b
)
>
m
b
(
>>>=
)
::
m
a
>
(
a
>
m
b
)
>
m
b
(
>>>
)
::
m
a
>
m
b
>
m
b
data
BP
a
=
BP
(
Int
>
(
ERR
a
Error
,
Int
))
instance
MonadErr
BP
Error
where
aerturn
k
=
BP
$
\
s
>
(
ERR
k
,
s
)
areturn
k
=
BP
$
\
s
>
(
EOK
k
,
s
)
acatch
k
try
handler
=
BP
$
\
s
>
let
BP
try'
=
try
k
(
r
,
s1
)
=
try'
s
(
BP
c2
,
s2
)
=
case
r
of
EOK
r
>
(
areturn
r
,
s1
)
ERR
r
>
(
handler
r
,
s
)
in
c2
s2
a
>>>
b
=
a
>>>=
\
_
>
b
(
BP
c1
)
>>>=
fc2
=
BP
$
\
s0
>
let
(
r
,
s1
)
=
c1
s0
BP
c2
=
case
r
of
EOK
r
>
fc2
r
ERR
r
>
BP
(
\
s
>
(
ERR
r
,
s
))
in
c2
s1
run_BP
::
Int
>
BP
a
>
(
ERR
a
Error
,
Int
)
run_BP
st
(
BP
bp
)
=
bp
st
foo
::
(
ERR
Int
Error
,
Int
)
foo
=
run_BP
111
(
aerturn
No
)
main
=
print
(
show
foo
)
Prev
1
2
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment