Make qReport force its error message before printing it
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 17 Apr 2014 10:15:16 +0000 (11:15 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 17 Apr 2014 10:15:36 +0000 (11:15 +0100)
Fixes Trac #8987.  See Note [Exceptions in TH]

Thanks to Yuras Shumovich for doing this.

compiler/typecheck/TcSplice.lhs
testsuite/tests/th/T8987.hs [new file with mode: 0644]
testsuite/tests/th/T8987.stderr [new file with mode: 0644]
testsuite/tests/th/all.T

index 2f4687d..7fce241 100644 (file)
@@ -845,6 +845,12 @@ like that.  Here's how it's processed:
     (qReport True s) by using addErr to add an error message to the bag of errors.
     The 'fail' in TcM raises an IOEnvFailure exception
 
+ * 'qReport' forces the message to ensure any exception hidden in unevaluated
+   thunk doesn't get into the bag of errors. Otherwise the following splice
+   will triger panic (Trac #8987):
+        $(fail undefined)
+   See also Note [Concealed TH exceptions]
+
   * So, when running a splice, we catch all exceptions; then for
         - an IOEnvFailure exception, we assume the error is already
                 in the error-bag (above)
@@ -875,8 +881,10 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
                   ; let i = getKey u
                   ; return (TH.mkNameU s i) }
 
-  qReport True msg  = addErr  (text msg)
-  qReport False msg = addWarn (text msg)
+  -- 'msg' is forced to ensure exceptions don't escape,
+  -- see Note [Exceptions in TH]
+  qReport True msg  = seqList msg $ addErr  (text msg)
+  qReport False msg = seqList msg $ addWarn (text msg)
 
   qLocation = do { m <- getModule
                  ; l <- getSrcSpanM
diff --git a/testsuite/tests/th/T8987.hs b/testsuite/tests/th/T8987.hs
new file mode 100644 (file)
index 0000000..d6f5781
--- /dev/null
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module T8987 where
+import Language.Haskell.TH
+
+$(reportWarning ['1', undefined] >> return [])
\ No newline at end of file
diff --git a/testsuite/tests/th/T8987.stderr b/testsuite/tests/th/T8987.stderr
new file mode 100644 (file)
index 0000000..2b128bb
--- /dev/null
@@ -0,0 +1,5 @@
+
+T8987.hs:1:1:
+    Exception when trying to run compile-time code:
+      Prelude.undefined
+    Code: (>>) reportWarning ['1', undefined] return []
index ce723dd..22bb7cc 100644 (file)
@@ -325,4 +325,5 @@ test('T8807', normal, compile, ['-v0'])
 test('T8884', normal, compile, ['-v0'])
 test('T8954', normal, compile, ['-v0'])
 test('T8932', normal, compile_fail, ['-v0'])
+test('T8987', normal, compile_fail, ['-v0'])