Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Alex D
GHC
Commits
4cc9b39a
Commit
4cc9b39a
authored
Apr 02, 2008
by
Ian Lynagh
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Add a test simplrun010 for trac #1947
parent
33c70ee8
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
317 additions
and
0 deletions
+317
-0
testsuite/tests/ghc-regress/simplCore/should_run/all.T
testsuite/tests/ghc-regress/simplCore/should_run/all.T
+3
-0
testsuite/tests/ghc-regress/simplCore/should_run/simplrun010.hs
...ite/tests/ghc-regress/simplCore/should_run/simplrun010.hs
+313
-0
testsuite/tests/ghc-regress/simplCore/should_run/simplrun010.stderr
...tests/ghc-regress/simplCore/should_run/simplrun010.stderr
+1
-0
No files found.
testsuite/tests/ghc-regress/simplCore/should_run/all.T
View file @
4cc9b39a
...
...
@@ -18,3 +18,6 @@ test('simplrun006', expect_broken(149), compile_and_run, [''])
test
('
simplrun007
',
normal
,
compile_and_run
,
[''])
test
('
simplrun008
',
normal
,
compile_and_run
,
[''])
test
('
simplrun009
',
normal
,
compile_and_run
,
[''])
test
('
simplrun010
',
composes
([
extra_run_opts
('
24 16 8
'),
exit_code
(
1
)])
,
compile_and_run
,
[''])
testsuite/tests/ghc-regress/simplCore/should_run/simplrun010.hs
0 → 100644
View file @
4cc9b39a
{-# OPTIONS_GHC -fffi -fglasgow-exts #-}
-- From trac #1947
module
Main
(
main
)
where
import
System.IO.Unsafe
import
System.IO
import
System.Environment
import
System.Exit
import
Foreign.C.Types
import
Data.Char
(
ord
,
chr
)
-- low level imports
import
GHC.Base
(
realWorld
#
)
import
GHC.IOBase
(
IO
(
IO
),
unIO
,
unsafePerformIO
)
import
GHC.Prim
(
State
#
,
RealWorld
)
-- FFI replacements for Haskell stuff
foreign
import
ccall
unsafe
"stdio.h getchar"
getchar
::
IO
CInt
foreign
import
ccall
unsafe
"ctype.h iswspace"
isspace
::
CInt
->
CInt
skipCAF
::
State
#
RealWorld
->
a
->
a
skipCAF
_
x
=
x
-- IO Subsystem
-- Unboxed IO is more efficient, but requires a certain level of
-- optimisation, so provide a BOXED_IO fallback
data
RW_Box
=
RW_Box
(
State
#
RealWorld
)
type
RW_Pair
a
=
(
RW_Box
,
a
)
fromIO
::
IO
a
->
(
RW_Box
->
RW_Pair
a
)
fromIO
a
(
RW_Box
r
)
=
case
unIO
a
r
of
(
#
r
,
x
#
)
->
(
RW_Box
r
,
x
)
toIO
::
(
RW_Box
->
RW_Pair
a
)
->
IO
a
toIO
f
=
IO
$
\
r
->
case
f
(
RW_Box
r
)
of
(
RW_Box
r
,
x
)
->
(
#
r
,
x
#
)
-- IO functions not dependent on the IO primitives
main
::
IO
()
main
=
toIO
main_generated
typeRealWorld
::
RW_Box
->
RW_Box
typeRealWorld
x
=
x
overlay_get_char
::
RW_Box
->
RW_Pair
Int
overlay_get_char
=
fromIO
$
do
c
<-
getchar
return
$
fromIntegral
c
system_IO_hPutChar
::
Handle
->
Int
->
RW_Box
->
RW_Pair
()
system_IO_hPutChar
h
c
=
fromIO
$
hPutChar
h
(
chr
c
)
overlay_errorIO
::
[
Int
]
->
RW_Box
->
RW_Pair
a
overlay_errorIO
x
r
=
case
fromIO
(
putStrLn
(
"ERROR: "
++
map
chr
x
))
r
of
(
r
,
_
)
->
fromIO
exitFailure
r
system_Environment_getArgs
::
RW_Box
->
RW_Pair
[[
Int
]]
system_Environment_getArgs
r
=
case
(
fromIO
getArgs
)
r
of
(
r
,
s
)
->
(
r
,
map
str_
s
)
overlay_supero_wrap
x
=
x
-- Primitives
prelude_seq
=
seq
prelude_error
x
=
error
(
map
chr
x
)
aDD_W
=
(
+
)
::
Int
->
Int
->
Int
mUL_W
=
(
*
)
::
Int
->
Int
->
Int
sUB_W
=
(
-
)
::
Int
->
Int
->
Int
eQ_W
=
(
==
)
::
Int
->
Int
->
Bool
nE_W
=
(
/=
)
::
Int
->
Int
->
Bool
gT_W
=
(
>
)
::
Int
->
Int
->
Bool
gE_W
=
(
>=
)
::
Int
->
Int
->
Bool
lT_W
=
(
<
)
::
Int
->
Int
->
Bool
lE_W
=
(
<=
)
::
Int
->
Int
->
Bool
qUOT
=
quot
::
Int
->
Int
->
Int
rEM
=
rem
::
Int
->
Int
->
Int
nEG_W
=
negate
::
Int
->
Int
yHC_Primitive_primIntAbs
=
abs
::
Int
->
Int
yHC_Primitive_primIntSignum
=
signum
::
Int
->
Int
yHC_Primitive_primIntegerAdd
=
(
+
)
::
Integer
->
Integer
->
Integer
yHC_Primitive_primIntegerEq
=
(
==
)
::
Integer
->
Integer
->
Bool
yHC_Primitive_primIntegerFromInt
=
toInteger
::
Int
->
Integer
yHC_Primitive_primIntegerGe
=
(
>=
)
::
Integer
->
Integer
->
Bool
yHC_Primitive_primIntegerGt
=
(
>
)
::
Integer
->
Integer
->
Bool
yHC_Primitive_primIntegerLe
=
(
<=
)
::
Integer
->
Integer
->
Bool
yHC_Primitive_primIntegerMul
=
(
*
)
::
Integer
->
Integer
->
Integer
yHC_Primitive_primIntegerNe
=
(
/=
)
::
Integer
->
Integer
->
Bool
yHC_Primitive_primIntegerNeg
=
negate
::
Integer
->
Integer
yHC_Primitive_primIntegerQuot
=
quot
::
Integer
->
Integer
->
Integer
yHC_Primitive_primIntegerQuotRem
=
quotRem
::
Integer
->
Integer
->
(
Integer
,
Integer
)
yHC_Primitive_primIntegerRem
=
rem
::
Integer
->
Integer
->
Integer
yHC_Primitive_primIntFromInteger
=
fromInteger
::
Integer
->
Int
yHC_Primitive_primIntegerLt
=
(
<
)
::
Integer
->
Integer
->
Bool
yHC_Primitive_primIntegerSub
=
(
-
)
::
Integer
->
Integer
->
Integer
aDD_D
=
(
+
)
::
Double
->
Double
->
Double
sUB_D
=
(
-
)
::
Double
->
Double
->
Double
lT_D
=
(
<
)
::
Double
->
Double
->
Bool
lE_D
=
(
<=
)
::
Double
->
Double
->
Bool
gT_D
=
(
>
)
::
Double
->
Double
->
Bool
gE_D
=
(
>=
)
::
Double
->
Double
->
Bool
eQ_D
=
(
==
)
::
Double
->
Double
->
Bool
mUL_D
=
(
*
)
::
Double
->
Double
->
Double
nEG_D
=
(
negate
)
::
Double
->
Double
nE_D
=
(
/=
)
::
Double
->
Double
->
Bool
sLASH_D
=
(
/
)
::
Double
->
Double
->
Double
yHC_Primitive_primDecodeDouble
=
decodeFloat
::
Double
->
(
Integer
,
Int
)
yHC_Primitive_primDoubleACos
=
acos
::
Double
->
Double
yHC_Primitive_primDoubleASin
=
asin
::
Double
->
Double
yHC_Primitive_primDoubleATan
=
atan
::
Double
->
Double
yHC_Primitive_primDoubleAbs
=
abs
::
Double
->
Double
yHC_Primitive_primDoubleCos
=
cos
::
Double
->
Double
yHC_Primitive_primDoubleExp
=
exp
::
Double
->
Double
yHC_Primitive_primDoubleFromInteger
=
fromInteger
::
Integer
->
Double
yHC_Primitive_primDoubleLog
=
log
::
Double
->
Double
yHC_Primitive_primDoublePow
=
(
**
)
::
Double
->
Double
->
Double
yHC_Primitive_primDoubleSignum
=
signum
::
Double
->
Double
yHC_Primitive_primDoubleSin
=
sin
::
Double
->
Double
yHC_Primitive_primDoubleSqrt
=
sqrt
::
Double
->
Double
yHC_Primitive_primDoubleTan
=
tan
::
Double
->
Double
yHC_Primitive_primEncodeDouble
=
encodeFloat
::
Integer
->
Int
->
Double
-- things which Yhc decides should be hopelessly slow
prelude_Int_Integral_mod
=
mod
::
Int
->
Int
->
Int
prelude_Integer_Integral_div
=
div
::
Integer
->
Integer
->
Integer
prelude_Integer_Integral_mod
=
mod
::
Integer
->
Integer
->
Integer
prelude_Integer_Num_signum
=
signum
::
Integer
->
Integer
prelude_Integer_Num_abs
=
abs
::
Integer
->
Integer
int_
x
=
x
::
Int
chr_
x
=
ord
x
str_
x
=
map
chr_
x
system_IO_stdin
=
stdin
system_IO_stdout
=
stdout
data_Char_isSpace
::
Int
->
Bool
data_Char_isSpace
c
=
isspace
(
toEnum
c
)
/=
0
type
ReadsPrec
a
=
Int
->
[
Int
]
->
[(
a
,[
Int
])]
prelude_Int_Read_readsPrec
::
ReadsPrec
Int
prelude_Int_Read_readsPrec
p
s
=
[(
a
,
str_
b
)
|
(
a
,
b
)
<-
readsPrec
p
(
map
chr
s
)]
prelude_Int_Read_readList
=
undefined
prelude_Integer_Read_readsPrec
::
ReadsPrec
Integer
prelude_Integer_Read_readsPrec
p
s
=
[(
a
,
str_
b
)
|
(
a
,
b
)
<-
readsPrec
p
(
map
chr
s
)]
prelude_Integer_Read_readList
=
undefined
prelude_Double_Read_readsPrec
::
ReadsPrec
Double
prelude_Double_Read_readsPrec
p
s
=
[(
a
,
str_
b
)
|
(
a
,
b
)
<-
readsPrec
p
(
map
chr
s
)]
prelude_Double_Read_readList
=
undefined
prelude_Char_Read_readsPrec
::
ReadsPrec
Int
prelude_Char_Read_readsPrec
p
s
=
[(
chr_
(
a
::
Char
),
str_
b
)
|
(
a
,
b
)
<-
readsPrec
p
(
map
chr
s
)]
prelude_Char_Show_showList
::
[
Int
]
->
[
Int
]
->
[
Int
]
prelude_Char_Show_showList
value
rest
=
str_
(
show
(
map
chr
value
))
++
rest
prelude_Char_Show_showsPrec
::
Int
->
Int
->
[
Int
]
->
[
Int
]
prelude_Char_Show_showsPrec
prec
i
rest
=
str_
(
showsPrec
prec
(
chr
i
)
[]
)
++
rest
prelude_Int_Show_showsPrec
::
Int
->
Int
->
[
Int
]
->
[
Int
]
prelude_Int_Show_showsPrec
prec
i
rest
=
str_
(
showsPrec
prec
i
[]
)
++
rest
prelude_Integer_Show_showsPrec
::
Int
->
Integer
->
[
Int
]
->
[
Int
]
prelude_Integer_Show_showsPrec
prec
i
rest
=
str_
(
showsPrec
prec
i
[]
)
++
rest
prelude_Double_Show_showsPrec
::
Int
->
Double
->
[
Int
]
->
[
Int
]
prelude_Double_Show_showsPrec
prec
i
rest
=
str_
(
showsPrec
prec
i
[]
)
++
rest
prelude_'amp'amp27
v1
v2
=
case
(
data_Char_isSpace
v1
)
of
True
->
case
v2
of
[]
->
True
(
:
)
v4
v5
->
prelude_'amp'amp27
v4
v5
False
->
False
prelude_LAMBDA22
v1
v2
=
case
v1
of
(,)
v267
v268
->
case
v268
of
[]
->
prelude_LAMBDA24
v267
v2
(
:
)
v7
v8
->
let
v11
=
prelude_'amp'amp27
v7
v8
in
case
v11
of
True
->
prelude_LAMBDA24
v267
v2
False
->
prelude__foldr25
v2
prelude_LAMBDA24
v1
v2
=
(
:
)
v1
(
prelude__foldr25
v2
)
prelude_IO_Monad_fail41
v1
=
overlay_errorIO
(
skipCAF
realWorld
#
(
str_
"pattern-match failure in do expression"
))
v1
prelude__foldr25
v1
=
case
v1
of
[]
->
[]
(
:
)
v296
v297
->
prelude_LAMBDA22
v296
v297
f17
uncaf
=
skipCAF
uncaf
(
str_
"Prelude.read: no parse"
)
f18
v1
v2
=
case
v1
of
(,)
v176
v177
->
case
v177
of
[]
->
f20
v176
v2
(
:
)
v7
v8
->
let
v11
=
prelude_'amp'amp27
v7
v8
in
case
v11
of
True
->
f20
v176
v2
False
->
case
v2
of
[]
->
prelude_error
(
f17
realWorld
#
)
(
:
)
v4
v5
->
f18
v4
v5
f20
v1
v2
=
case
v2
of
[]
->
v1
(
:
)
v257
v258
->
let
v9
=
prelude_LAMBDA22
v257
v258
in
case
v9
of
[]
->
v1
(
:
)
v10
v11
->
prelude_error
(
skipCAF
realWorld
#
(
str_
"Prelude.read: ambiguous parse"
))
f34
v1
v2
v3
=
let
v336
=
f34
v1
v2
v3
in
v336
f38
v1
v2
=
case
v1
of
[]
->
system_IO_hPutChar
system_IO_stdout
(
chr_
'
\n
'
)
v2
(
:
)
v350
v351
->
case
(
system_IO_hPutChar
system_IO_stdout
v350
(
typeRealWorld
v2
))
of
(
v7
,
v8
)
->
f38
v351
v7
main_generated
v1
=
case
(
system_Environment_getArgs
(
typeRealWorld
v1
))
of
(
v3
,
v4
)
->
case
v4
of
(
:
)
v7
v8
->
case
v8
of
(
:
)
v9
v12
->
case
v12
of
(
:
)
v13
v14
->
case
v14
of
[]
->
case
(
prelude_Int_Show_showsPrec
(
int_
0
)
(
let
v8
=
case
(
prelude_Int_Read_readsPrec
(
int_
0
)
v7
)
of
[]
->
prelude_error
(
f17
realWorld
#
)
(
:
)
v12
v14
->
f18
v12
v14
v10
=
case
(
prelude_Int_Read_readsPrec
(
int_
0
)
v9
)
of
[]
->
prelude_error
(
f17
realWorld
#
)
(
:
)
v15
v16
->
f18
v15
v16
v11
=
case
(
prelude_Int_Read_readsPrec
(
int_
0
)
v13
)
of
[]
->
prelude_error
(
f17
realWorld
#
)
(
:
)
v17
v18
->
f18
v17
v18
in
case
(
lT_W
v10
v8
)
of
True
->
let
v7
=
f34
v8
v10
v11
in
v7
False
->
v11
)
(
skipCAF
realWorld
#
(
str_
""
)))
of
[]
->
system_IO_hPutChar
system_IO_stdout
(
chr_
'
\n
'
)
(
typeRealWorld
v3
)
(
:
)
v11
v12
->
case
(
system_IO_hPutChar
system_IO_stdout
v11
(
typeRealWorld
(
typeRealWorld
v3
)))
of
(
v7
,
v8
)
->
f38
v12
v7
(
:
)
v15
v16
->
prelude_IO_Monad_fail41
v3
[]
->
prelude_IO_Monad_fail41
v3
[]
->
prelude_IO_Monad_fail41
v3
[]
->
prelude_IO_Monad_fail41
v3
testsuite/tests/ghc-regress/simplCore/should_run/simplrun010.stderr
0 → 100644
View file @
4cc9b39a
simplrun010: <<loop>>
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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