Re: What is testsuite/tests/rename/should_fail/rnfail018.hs supposed to test?

2014-09-08 Thread Jan Stolarek
David,

the comment in the test says what crashed ghc-4.04proto: "the parens after the 
for-all fooled it". 
So I suppose that "forall b. StateMonad (a,b) m => m a" worked fine but "forall 
b. (StateMonad 
(a,b) m => m a)" crashed GHC. This test is in a should_fail folder, which means 
that the 
compilation of this file should fail and GHC should report an error. Take a 
look at the 
rnfail018.stderr file. It says what output do we expect on the standard error. 
You can see that 
we expect a and m to be out of scope, which according to your mail is exactly 
what happens. Note 
also the file name - rnfail - which stands for "renamer failure" (you can see 
this also from 
names of directories).

Janek


Dnia poniedziałek, 8 września 2014, David Feuer napisał:
> When I compile this with 7.8.3, it gives an error message saying that type
> variables a and m are not in scope. If I add them to the forall, it tells
> me I need FlexibleContexts. If I add that, then it gives me an error about
> an ambiguous type variable. Clearly, something crashed ghc-4.04proto, but
> there's no indication of what that was. If this test is still at all
> relevant, it probably needs to be updated to target something more
> narrowly.
>
> The program:
>
> {-# LANGUAGE MultiParamTypeClasses, ExplicitForAll #-}
> module ShouldFail where
> -- !!! For-all with parens
> -- This one crashed ghc-4.04proto; the parens after the for-all fooled it
>
> class Monad m => StateMonad s m where
>getState :: m s
>
> setState0 :: forall b. (StateMonad (a,b) m => m a)
> setState0 = getState >>= \ (l,_r) -> return l
>
> David Feuer


___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs


No context in error messages

2014-09-08 Thread Corentin Dupont
Hi everybody,
I am working with Hint, after some discussion with Daniel Gorin, I decided
to post here, I hope it's the right place.
My problem with Hint is that I cannot get context in error messages while
interpreting a string. If you run the attached file example.hs, you get:

GhcError {errMsg = "No instance for (GHC.Num.Num GHC.Base.String)\n
arising from a use of `GHC.Num.+'\nPossible fix:\n  add an instance
declaration for (GHC.Num.Num GHC.Base.String)"}

There is no context (line number, code snippets...), plus the error message
uses fully qualified names, which is not very readable.
It's very hard to figure out where the problem is when interpreting a long
string.
But the same error in a file that is loaded with Hint gives the correct
message (uncomment the putStrLn in SomeModule.hs to get it):

GhcError {errMsg = ":\n[1 of 1] Compiling
SomeModule   ( SomeModule.hs, interpreted )"},GhcError {errMsg =
"SomeModule.hs:5:22:\nNo instance for (Num String) arising from a use
of `+'\nPossible fix: add an instance declaration for (Num String)\n
In the second argument of `($)', namely `\"bar\" + 1'\nIn a stmt of a
'do' block: putStrLn $ \"bar\" + 1\nIn the expression:\n  do {
putStrLn \"bar\";\n   putStrLn $ \"bar\" + 1 }"}

This error is much better: it gives line number plus some code snippets
("In the second argument of...").

There might be a flag that is not correctly set in GHC? After a quick look
I'm thinking of GHC.DynFlags (I'm no expert). Now it is configured with:
configureDynFlags :: GHC.DynFlags -> GHC.DynFlags
configureDynFlags dflags = dflags{GHC.ghcMode= GHC.CompManager,
  GHC.hscTarget  = GHC.HscInterpreted,
  GHC.ghcLink= GHC.LinkInMemory,
  GHC.verbosity  = 0}

Thanks,
Corentin
import Control.Monad
import Language.Haskell.Interpreter

main :: IO ()
main = do r <- runInterpreter testHint
  case r of
Left err -> printInterpreterError err
Right () -> putStrLn "that's all folks"

testHint :: Interpreter ()
testHint =
do
  loadModules ["SomeModule.hs"]
  setTopLevelModules ["SomeModule"]
  setImportsQ [("Prelude", Nothing)]
  --the following expression will generate an error message without context??
  let expr = "do\n   putStrLn \"foo\"\n   putStrLn $ \"bar\" + 1\n"
  interpret expr (as :: IO ())
  return ()

printInterpreterError :: InterpreterError -> IO ()
printInterpreterError e = putStrLn $ "Ups... " ++ (show e)

module SomeModule where

f = do
   putStrLn "foo"
   -- uncomment to see error message with module loading 
   --putStrLn $ "toto" + 1 
___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs


What is testsuite/tests/rename/should_fail/rnfail018.hs supposed to test?

2014-09-08 Thread David Feuer
When I compile this with 7.8.3, it gives an error message saying that type
variables a and m are not in scope. If I add them to the forall, it tells
me I need FlexibleContexts. If I add that, then it gives me an error about
an ambiguous type variable. Clearly, something crashed ghc-4.04proto, but
there's no indication of what that was. If this test is still at all
relevant, it probably needs to be updated to target something more narrowly.

The program:

{-# LANGUAGE MultiParamTypeClasses, ExplicitForAll #-}
module ShouldFail where
-- !!! For-all with parens
-- This one crashed ghc-4.04proto; the parens after the for-all fooled it

class Monad m => StateMonad s m where
   getState :: m s

setState0 :: forall b. (StateMonad (a,b) m => m a)
setState0 = getState >>= \ (l,_r) -> return l

David Feuer
___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs


HEAD fails to bootstrap with HEAD?

2014-09-08 Thread Karel Gardas

Hello,

I've noticed that probably after cabal/ghc-pkg changes done recently 
HEAD fails to build with HEAD in following way:


[80 of 80] Compiling Main ( utils/ghc-cabal/Main.hs, 
bootstrapping/Main.o )

Linking utils/ghc-cabal/dist/build/tmp/ghc-cabal ...
"touch" utils/ghc-cabal/dist/build/tmp/ghc-cabal
"cp" utils/ghc-cabal/dist/build/tmp/ghc-cabal inplace/bin/ghc-cabal
"inplace/bin/mkdirhier" compiler/stage1/build//.
"rm" -f compiler/stage1/build/Config.hs
Creating compiler/stage1/build/Config.hs ...
done.
"inplace/bin/ghc-cabal" configure libraries/Cabal/Cabal dist-boot "" 
--with-ghc="/opt/ghc-7.9.20140906-amd64/bin/ghc" 
--with-ghc-pkg="/opt/ghc-7.9.20140906-amd64/bin/ghc-pkg" 
--package-db=/export/home/karel/vcs/ghc-src/head/libraries/bootstrapping.conf 
--disable-library-for-ghci --enable-library-vanilla 
--disable-library-profiling --disable-shared 
--with-hscolour="/export/home/karel/.cabal/bin/HsColour" 
--configure-option=CFLAGS=" -m64 -fno-stack-protector   " 
--configure-option=LDFLAGS=" -m64  " --configure-option=CPPFLAGS=" -m64 
 " --gcc-options=" -m64 -fno-stack-protector -m64  " 
--configure-option=--with-gmp-includes="/usr/include/gmp" 
--configure-option=--with-gmp-libraries="/usr/lib/"   --constraint 
"Cabal == 1.21.1.0"   --constraint "hpc == 0.6.0.1"   --constraint 
"binary == 0.7.1.0"   --constraint "bin-package-db == 0.0.0.0" 
--constraint "hoopl == 3.10.0.1"   --constraint "transformers == 
0.4.1.0"   --constraint "terminfo == 0.4.0.0" --with-gcc="/usr/bin/gcc" 
--configure-option=--with-cc="/usr/bin/gcc" --with-ar="/usr/xpg4/bin/ar" 
--with-alex="/export/home/karel/.cabal/bin/alex" 
--with-happy="/export/home/karel/.cabal/bin/happy"

Configuring Cabal-1.21.1.0...
ghc-cabal: '/opt/ghc-7.9.20140906-amd64/bin/ghc-pkg' exited with an error:
ghc-pkg: ghc no longer supports single-file style package databases
(/export/home/karel/vcs/ghc-src/head/libraries/bootstrapping.conf) use
'ghc-pkg init' to create the database with the correct format.
gmake[1]: *** [libraries/Cabal/Cabal/dist-boot/package-data.mk] Error 1
gmake: *** [all] Error 2


I've been able to solve this by:

$ rm libraries/bootstrapping.conf
$ /opt/ghc-7.9.20140906-amd64/bin/ghc-pkg init libraries/bootstrapping.conf

however it's kind of impractical to do that on buildbot (solaris/amd64). 
Is it possible to fix that somehow?


Thanks!
Karel
___
ghc-devs mailing list
ghc-devs@haskell.org
http://www.haskell.org/mailman/listinfo/ghc-devs