diff options
-rw-r--r-- | compiler/GHC/Tc/Gen/Splice.hs | 5 | ||||
-rw-r--r-- | testsuite/tests/linear/should_fail/LinearTHFail.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/linear/should_fail/LinearTHFail.stderr | 13 | ||||
-rw-r--r-- | testsuite/tests/linear/should_fail/all.T | 1 |
4 files changed, 29 insertions, 1 deletions
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs index 5871eb99ea..54e736fda5 100644 --- a/compiler/GHC/Tc/Gen/Splice.hs +++ b/compiler/GHC/Tc/Gen/Splice.hs @@ -192,6 +192,8 @@ tcTypedBracket rn_expr brack@(TExpBr _ expr) res_ty -- Throw away the typechecked expression but return its type. -- We'll typecheck it again when we splice it in somewhere ; (_tc_expr, expr_ty) <- setStage (Brack cur_stage (TcPending ps_ref lie_var wrapper)) $ + tcScalingUsage Many $ + -- Scale by Many, TH lifting is currently nonlinear (#18465) tcInferRhoNC expr -- NC for no context; tcBracket does that ; let rep = getRuntimeRep expr_ty @@ -289,7 +291,8 @@ tcPendingSplice m_var (PendingRnSplice flavour splice_name expr) = do { meta_ty <- tcMetaTy meta_ty_name -- Expected type of splice, e.g. m Exp ; let expected_type = mkAppTy m_var meta_ty - ; expr' <- tcCheckPolyExpr expr expected_type + ; expr' <- tcScalingUsage Many $ tcCheckPolyExpr expr expected_type + -- Scale by Many, TH lifting is currently nonlinear (#18465) ; return (PendingTcSplice splice_name expr') } where meta_ty_name = case flavour of diff --git a/testsuite/tests/linear/should_fail/LinearTHFail.hs b/testsuite/tests/linear/should_fail/LinearTHFail.hs new file mode 100644 index 0000000000..42878e5dad --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearTHFail.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskellQuotes, LinearTypes #-} + +module LinearTHFail where -- #18465 + +import Language.Haskell.TH + +f :: Q Exp %1 -> Q Exp +f x = [| Just $x |] + +g :: Code Q a %1 -> Code Q (Maybe a) +g x = [|| Just $$x ||] diff --git a/testsuite/tests/linear/should_fail/LinearTHFail.stderr b/testsuite/tests/linear/should_fail/LinearTHFail.stderr new file mode 100644 index 0000000000..58537e811e --- /dev/null +++ b/testsuite/tests/linear/should_fail/LinearTHFail.stderr @@ -0,0 +1,13 @@ + +LinearTHFail.hs:8:3: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘f’: + f x + = [| Just $x |] + pending(rn) [<splice, x>] + +LinearTHFail.hs:11:3: error: + • Couldn't match type ‘'Many’ with ‘'One’ + arising from multiplicity of ‘x’ + • In an equation for ‘g’: g x = [|| Just $$x ||] diff --git a/testsuite/tests/linear/should_fail/all.T b/testsuite/tests/linear/should_fail/all.T index 272e9e2a35..5fa6fdb18f 100644 --- a/testsuite/tests/linear/should_fail/all.T +++ b/testsuite/tests/linear/should_fail/all.T @@ -30,3 +30,4 @@ test('LinearSequenceExpr', normal, compile_fail, ['']) test('LinearIf', normal, compile_fail, ['']) test('LinearPatternGuardWildcard', normal, compile_fail, ['']) test('LinearFFI', normal, compile_fail, ['']) +test('LinearTHFail', normal, compile_fail, ['']) |