Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
GHC
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Requirements
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Locked files
Build
Pipelines
Jobs
Pipeline schedules
Test cases
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Code review analytics
Issue analytics
Insights
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Alexander Kaznacheev
GHC
Commits
921a1d5d
Commit
921a1d5d
authored
13 years ago
by
pcapriotti
Browse files
Options
Downloads
Patches
Plain Diff
Prevent nested TH exceptions from bubbling up to the top level (#5976)
MERGED from commit
e7e5e277
parent
961b2e55
No related branches found
No related tags found
No related merge requests found
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
compiler/typecheck/TcSplice.lhs
+24
-5
24 additions, 5 deletions
compiler/typecheck/TcSplice.lhs
compiler/utils/Panic.lhs
+13
-1
13 additions, 1 deletion
compiler/utils/Panic.lhs
with
37 additions
and
6 deletions
compiler/typecheck/TcSplice.lhs
+
24
−
5
View file @
921a1d5d
...
@@ -828,7 +828,7 @@ runMeta show_code run_and_convert expr
...
@@ -828,7 +828,7 @@ runMeta show_code run_and_convert expr
; either_hval <- tryM $ liftIO $
; either_hval <- tryM $ liftIO $
HscMain.hscCompileCoreExpr hsc_env src_span ds_expr
HscMain.hscCompileCoreExpr hsc_env src_span ds_expr
; case either_hval of {
; case either_hval of {
Left exn -> fail
W
ith
Tc (mk_msg
"compile and link" exn
)
;
Left exn -> fail
_w
ith
_exn
"compile and link" exn ;
Right hval -> do
Right hval -> do
{ -- Coerce it to Q t, and run it
{ -- Coerce it to Q t, and run it
...
@@ -856,12 +856,16 @@ runMeta show_code run_and_convert expr
...
@@ -856,12 +856,16 @@ runMeta show_code run_and_convert expr
Right v -> return v
Right v -> return v
Left se -> case fromException se of
Left se -> case fromException se of
Just IOEnvFailure -> failM -- Error already in Tc monad
Just IOEnvFailure -> failM -- Error already in Tc monad
_ -> fail
W
ith
Tc (mk_msg
"run" se
)
-- Exception
_ -> fail
_w
ith
_exn
"run" se -- Exception
}}}
}}}
where
where
mk_msg s exn = vcat [text "Exception when trying to" <+> text s <+> text "compile-time code:",
-- see Note [Concealed TH exceptions]
nest 2 (text (Panic.showException exn)),
fail_with_exn phase exn = do
if show_code then nest 2 (text "Code:" <+> ppr expr) else empty]
exn_msg <- liftIO $ Panic.safeShowException exn
let msg = vcat [text "Exception when trying to" <+> text phase <+> text "compile-time code:",
nest 2 (text exn_msg),
if show_code then nest 2 (text "Code:" <+> ppr expr) else empty]
failWithTc msg
\end{code}
\end{code}
Note [Exceptions in TH]
Note [Exceptions in TH]
...
@@ -893,6 +897,21 @@ like that. Here's how it's processed:
...
@@ -893,6 +897,21 @@ like that. Here's how it's processed:
- other errors, we add an error to the bag
- other errors, we add an error to the bag
and then fail
and then fail
Note [Concealed TH exceptions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When displaying the error message contained in an exception originated from TH
code, we need to make sure that the error message itself does not contain an
exception. For example, when executing the following splice:
$( error ("foo " ++ error "bar") )
the message for the outer exception is a thunk which will throw the inner
exception when evaluated.
For this reason, we display the message of a TH exception using the
'safeShowException' function, which recursively catches any exception thrown
when showing an error message.
To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
To call runQ in the Tc monad, we need to make TcM an instance of Quasi:
...
...
This diff is collapsed.
Click to expand it.
compiler/utils/Panic.lhs
+
13
−
1
View file @
921a1d5d
...
@@ -22,7 +22,7 @@ module Panic (
...
@@ -22,7 +22,7 @@ module Panic (
panic, sorry, panicFastInt, assertPanic, trace,
panic, sorry, panicFastInt, assertPanic, trace,
Exception.Exception(..), showException, try, tryMost, throwTo,
Exception.Exception(..), showException,
safeShowException,
try, tryMost, throwTo,
installSignalHandlers, interruptTargetThread
installSignalHandlers, interruptTargetThread
) where
) where
...
@@ -113,6 +113,18 @@ short_usage = "Usage: For basic information, try the `--help' option."
...
@@ -113,6 +113,18 @@ short_usage = "Usage: For basic information, try the `--help' option."
showException :: Exception e => e -> String
showException :: Exception e => e -> String
showException = show
showException = show
-- | Show an exception which can possibly throw other exceptions.
-- Used when displaying exception thrown within TH code.
safeShowException :: Exception e => e -> IO String
safeShowException e = do
-- ensure the whole error message is evaluated inside try
r <- try (return $! forceList (showException e))
case r of
Right msg -> return msg
Left e' -> safeShowException (e' :: SomeException)
where
forceList [] = []
forceList xs@(x : xt) = x `seq` forceList xt `seq` xs
-- | Append a description of the given exception to this string.
-- | Append a description of the given exception to this string.
showGhcException :: GhcException -> String -> String
showGhcException :: GhcException -> String -> String
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment