Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
curry
curry-frontend
Commits
a68ce6c3
Commit
a68ce6c3
authored
Apr 13, 2016
by
Jan Rasmus Tikovsky
Browse files
Merge branch 'WarningsFeature'
parents
59d75a24
fc41b709
Changes
6
Hide whitespace changes
Inline
Side-by-side
src/Base/Messages.hs
View file @
a68ce6c3
module
Base.Messages
(
-- * Output of user information
status
,
warn
,
putErrLn
,
putErrsLn
status
,
putErrLn
,
putErrsLn
-- * program abortion
,
abortWith
,
abortWithMessage
,
abortWithMessages
,
abortWith
,
abortWithMessage
,
abortWithMessages
,
warnOrAbort
,
internalError
,
errorMessage
,
errorMessages
-- * creating messages
,
Message
,
message
,
posMessage
...
...
@@ -15,23 +15,14 @@ import Data.List (sort)
import
System.IO
(
hFlush
,
hPutStrLn
,
stderr
,
stdout
)
import
System.Exit
(
exitFailure
)
import
Curry.Base.Message
(
Message
,
message
,
posMessage
,
ppMessage
,
ppMessages
,
ppWarning
,
ppError
)
import
Curry.Base.Monad
(
CYIO
,
failMessages
)
import
Curry.Base.Pretty
(
text
)
import
Curry.Base.Message
(
Message
,
message
,
posMessage
,
ppWarning
,
ppMessages
,
ppError
)
import
Curry.Base.Pretty
(
Doc
,
text
)
import
CompilerOpts
(
Options
(
..
),
WarnOpts
(
..
),
Verbosity
(
..
))
status
::
MonadIO
m
=>
Options
->
String
->
m
()
status
opts
msg
=
unless
(
optVerbosity
opts
<
VerbStatus
)
(
putMsg
msg
)
-- TODO: bad code: Extend Curry monads (CYT / CYIO) to also track warnings
-- (see ticket 1246)
warn
::
WarnOpts
->
[
Message
]
->
CYIO
()
warn
opts
msgs
=
when
(
wnWarn
opts
&&
not
(
null
msgs
))
$
do
if
wnWarnAsError
opts
then
failMessages
(
msgs
++
[
message
$
text
"Failed due to -Werror"
])
else
liftIO
$
putErrLn
(
show
$
ppMessages
ppWarning
$
sort
msgs
)
-- |Print a message on 'stdout'
putMsg
::
MonadIO
m
=>
String
->
m
()
putMsg
msg
=
liftIO
(
putStrLn
msg
>>
hFlush
stdout
)
...
...
@@ -55,9 +46,20 @@ abortWithMessage msg = abortWithMessages [msg]
-- |Print a list of error messages on 'stderr' and abort the program
abortWithMessages
::
[
Message
]
->
IO
a
abortWithMessages
msgs
=
do
unless
(
null
msgs
)
$
putErrLn
(
show
$
ppMessages
ppMessage
$
sort
msgs
)
exitFailure
abortWithMessages
msgs
=
printMessages
ppError
msgs
>>
exitFailure
-- |Print a list of warning messages on 'stderr' and abort the program
-- |if the -Werror option is set
warnOrAbort
::
WarnOpts
->
[
Message
]
->
IO
()
warnOrAbort
opts
msgs
=
when
(
wnWarn
opts
&&
not
(
null
msgs
))
$
do
if
wnWarnAsError
opts
then
abortWithMessages
(
msgs
++
[
message
$
text
"Failed due to -Werror"
])
else
printMessages
ppWarning
msgs
-- |Print a list of messages on 'stderr'
printMessages
::
(
Message
->
Doc
)
->
[
Message
]
->
IO
()
printMessages
msgType
msgs
=
unless
(
null
msgs
)
$
putErrLn
(
show
$
ppMessages
msgType
$
sort
msgs
)
-- |Raise an internal error
internalError
::
String
->
a
...
...
src/Interfaces.hs
View file @
a68ce6c3
...
...
@@ -107,7 +107,7 @@ compileInterface ctxt (p, m) fn = do
mbSrc
<-
liftIO
$
readModule
fn
case
mbSrc
of
Nothing
->
report
[
errInterfaceNotFound
p
m
]
Just
src
->
case
runCYM
(
parseInterface
fn
src
)
of
Just
src
->
case
runCYM
IgnWarn
(
parseInterface
fn
src
)
of
Left
err
->
report
err
Right
intf
@
(
Interface
n
is
_
)
->
if
m
/=
n
...
...
src/Modules.hs
View file @
a68ce6c3
...
...
@@ -85,7 +85,7 @@ compileModule opts fn = do
loadAndCheckModule
::
Options
->
FilePath
->
CYIO
(
CompEnv
CS
.
Module
)
loadAndCheckModule
opts
fn
=
do
(
env
,
mdl
)
<-
loadModule
opts
fn
>>=
checkModule
opts
warn
(
optWarnOpts
opts
)
$
warnCheck
opts
env
mdl
warn
Messages
$
warnCheck
opts
env
mdl
return
(
env
,
mdl
)
-- ---------------------------------------------------------------------------
...
...
@@ -286,7 +286,7 @@ matchInterface :: FilePath -> CS.Interface -> IO Bool
matchInterface
ifn
i
=
do
hdl
<-
openFile
ifn
ReadMode
src
<-
hGetContents
hdl
case
runCYM
(
CS
.
parseInterface
ifn
src
)
of
case
runCYM
IgnWarn
(
CS
.
parseInterface
ifn
src
)
of
Left
_
->
hClose
hdl
>>
return
False
Right
i'
->
return
(
i
`
intfEquiv
`
fixInterface
i'
)
...
...
src/cymake.hs
View file @
a68ce6c3
...
...
@@ -39,8 +39,11 @@ cymake (prog, opts, files, errs)
runCYIO
(
mapM_
(
source2html
opts
)
files
)
>>=
okOrAbort
|
otherwise
=
runCYIO
(
mapM_
(
buildCurry
opts
)
files
)
>>=
okOrAbort
where
mode
=
optMode
opts
okOrAbort
=
either
abortWithMessages
return
where
mode
=
optMode
opts
warnOpts
=
optWarnOpts
opts
okOrAbort
=
either
abortWithMessages
continueWithMessages
continueWithMessages
=
warnOrAbort
warnOpts
.
snd
-- |Print the usage information of the command line tool
printUsage
::
String
->
IO
()
...
...
test/TestFrontend.hs
View file @
a68ce6c3
...
...
@@ -42,23 +42,25 @@ tests = return [passingTests, warningTests, failingTests]
-- Execute a test by calling cymake
runTest
::
CO
.
Options
->
String
->
[
String
]
->
IO
Progress
runTest
opts
test
[]
=
runCYIO
(
buildCurry
opts
test
)
>>=
passOrFail
runTest
opts
test
[]
=
runCYIO
(
buildCurry
opts
'
test
)
>>=
passOrFail
where
passOrFail
=
(
Finished
<$>
)
.
either
fail
pass
opts'
=
opts
{
CO
.
optForce
=
True
}
passOrFail
=
(
Finished
<$>
)
.
either
fail
pass
fail
msgs
|
null
msgs
=
return
Pass
|
otherwise
=
return
$
Fail
$
"An unexpected failure occurred"
pass
_
=
return
Pass
|
otherwise
=
let
errorStr
=
showMessages
msgs
in
return
$
Fail
$
"An unexpected failure occurred: "
++
errorStr
pass
_
=
return
Pass
runTest
opts
test
errorMsgs
=
runCYIO
(
buildCurry
opts'
test
)
>>=
catchE
where
opts'
=
opts
{
CO
.
opt
WarnOpts
=
CO
.
defaultWarnOpts
{
CO
.
wnWarnAsError
=
True
}
}
catchE
=
(
Finished
<$>
)
.
either
pass
fail
pass
msgs
=
let
errorStr
=
showMessages
m
sgs
in
if
all
(`
isInfixOf
`
errorStr
)
errorMsg
s
then
return
Pass
else
return
$
Fail
$
"Expected warning/failure did not occur: "
++
errorStr
fail
_
=
return
$
Fail
"Expected warning/failure did not occur"
opts'
=
opts
{
CO
.
opt
Force
=
True
}
catchE
=
(
Finished
<$>
)
.
either
pass
fail
pass
msgs
=
let
errorStr
=
showMessages
msgs
in
if
all
(`
isInfixOf
`
errorStr
)
errorM
sgs
then
return
Pas
s
else
return
$
Fail
$
"Expected warning/failure did not occur: "
++
errorStr
fail
=
pass
.
snd
showMessages
::
[
Message
]
->
String
showMessages
=
show
.
ppMessages
ppError
.
sort
...
...
@@ -275,4 +277,6 @@ warnInfos = map (uncurry mkFailTest)
)
,
(
"ShadowingSymbols"
,
[
"Unused declaration of variable `x'"
,
"Shadowing symbol `x'"
])
,
(
"TabCharacter"
,
[
"Tab character"
])
]
test/warning/TabCharacter.curry
0 → 100644
View file @
a68ce6c3
f :: Int
f = let x = 42 in x
Write
Preview
Supports
Markdown
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