[Git][ghc/ghc][wip/T18835] 4 commits: Parser regression tests, close #12862 #12446
Ben Gamari
gitlab at gitlab.haskell.org
Mon Oct 26 14:15:29 UTC 2020
Ben Gamari pushed to branch wip/T18835 at Glasgow Haskell Compiler / GHC
Commits:
e2c4a947 by Vladislav Zavialov at 2020-10-21T16:00:30+03:00
Parser regression tests, close #12862 #12446
These issues were fixed by earlier parser changes, most likely related
to whitespace-sensitive parsing.
- - - - -
711929e6 by Simon Peyton Jones at 2020-10-23T02:42:59-04:00
Fix error message location in tcCheckPatSynDecl
Ticket #18856 showed that we were failing to set the right location
for an error message. Easy to fix, happily.
Turns out that this also improves the error location in test T11010,
which was bogus before but we had never noticed.
- - - - -
730bb590 by Ben Gamari at 2020-10-23T02:43:33-04:00
cmm: Add Note reference to ForeignHint
- - - - -
d963882e by Ben Gamari at 2020-10-26T10:15:22-04:00
hadrian: Suppress xelatex output unless it fails
As noted in #18835, xelatex produces an absurd amount of output, nearly
all of which is meaningless. Silence this.
Fixes #18835.
- - - - -
13 changed files:
- compiler/GHC/Cmm/Type.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- hadrian/hadrian.cabal
- hadrian/src/Builder.hs
- + testsuite/tests/parser/should_compile/T12862.hs
- testsuite/tests/parser/should_compile/all.T
- + testsuite/tests/parser/should_fail/T12446.hs
- + testsuite/tests/parser/should_fail/T12446.stderr
- testsuite/tests/parser/should_fail/all.T
- testsuite/tests/patsyn/should_fail/T11010.stderr
- + testsuite/tests/patsyn/should_fail/T18856.hs
- + testsuite/tests/patsyn/should_fail/T18856.stderr
- testsuite/tests/patsyn/should_fail/all.T
Changes:
=====================================
compiler/GHC/Cmm/Type.hs
=====================================
@@ -311,6 +311,8 @@ isVecType _ = False
-- Hints are extra type information we attach to the arguments and
-- results of a foreign call, where more type information is sometimes
-- needed by the ABI to make the correct kind of call.
+--
+-- See Note [Signed vs unsigned] for one case where this is used.
data ForeignHint
= NoHint | AddrHint | SignedHint
=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -31,9 +31,9 @@ import GHC.Tc.Utils.TcMType
import GHC.Tc.Utils.Zonk
import GHC.Builtin.Types.Prim
import GHC.Types.Name
+import GHC.Types.Name.Set
import GHC.Types.SrcLoc
import GHC.Core.PatSyn
-import GHC.Types.Name.Set
import GHC.Utils.Panic
import GHC.Utils.Outputable
import GHC.Data.FastString
@@ -422,14 +422,22 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details
; tc_patsyn_finish lname dir is_infix lpat'
(univ_bndrs, req_theta, ev_binds, req_dicts)
(ex_bndrs, mkTyVarTys ex_tvs', prov_theta, prov_dicts)
- (args', (map scaledThing arg_tys))
+ (args', map scaledThing arg_tys)
pat_ty rec_fields }
where
tc_arg :: TCvSubst -> Name -> Type -> TcM (LHsExpr GhcTc)
+ -- Look up the variable actually bound by lpat
+ -- and check that it has the expected type
tc_arg subst arg_name arg_ty
- = do { -- Look up the variable actually bound by lpat
- -- and check that it has the expected type
- arg_id <- tcLookupId arg_name
+ = setSrcSpan (nameSrcSpan arg_name) $
+ -- Set the SrcSpan to be the binding site of the Id (#18856)
+ -- e.g. pattern P :: Int -> Maybe (Int,Bool)
+ -- pattern P x = Just (x,True)
+ -- Before unifying x's actual type with its expected type, in tc_arg, set
+ -- location to x's binding site in lpat, namely the 'x' in Just (x,True).
+ -- Else the error message location is wherever tcCheckPat finished,
+ -- namely the right-hand corner of the pattern
+ do { arg_id <- tcLookupId arg_name
; wrap <- tcSubTypeSigma GenSigCtxt
(idType arg_id)
(substTyUnchecked subst arg_ty)
=====================================
hadrian/hadrian.cabal
=====================================
@@ -138,6 +138,7 @@ executable hadrian
build-depends: Cabal >= 3.0 && < 3.3
, QuickCheck >= 2.6 && < 2.14
, base >= 4.8 && < 5
+ , bytestring >= 0.10 && < 0.12
, containers >= 0.5 && < 0.7
, directory >= 1.3.1.0 && < 1.4
, extra >= 1.4.7
=====================================
hadrian/src/Builder.hs
=====================================
@@ -15,6 +15,7 @@ module Builder (
) where
import Control.Exception.Extra (Partial)
+import qualified Data.ByteString.Lazy.Char8 as BSL
import Development.Shake.Classes
import Development.Shake.Command
import GHC.Generics
@@ -26,6 +27,8 @@ import Hadrian.Builder.Tar
import Hadrian.Oracles.Path
import Hadrian.Oracles.TextFile
import Hadrian.Utilities
+import System.Exit
+import System.IO (stderr)
import Base
import Context
@@ -286,7 +289,18 @@ instance H.Builder Builder where
Makeinfo -> do
cmd' echo [path] "--no-split" [ "-o", output] [input]
- Xelatex -> unit $ cmd' [Cwd output] [path] buildArgs
+ Xelatex ->
+ -- xelatex produces an incredible amount of output, almost
+ -- all of which is useless. Suppress it unless user
+ -- requests a loud build.
+ if verbosity >= Loud
+ then cmd' [Cwd output] [path] buildArgs
+ else do (Stdouterr out, Exit code) <- cmd' [Cwd output] [path] buildArgs
+ when (code /= ExitSuccess) $ do
+ liftIO $ BSL.hPutStrLn stderr out
+ putFailure "xelatex failed!"
+ fail "xelatex failed"
+
Makeindex -> unit $ cmd' [Cwd output] [path] (buildArgs ++ [input])
Tar _ -> cmd' buildOptions echo [path] buildArgs
=====================================
testsuite/tests/parser/should_compile/T12862.hs
=====================================
@@ -0,0 +1,16 @@
+{-# LANGUAGE TypeFamilies, InstanceSigs #-}
+{-# LANGUAGE BangPatterns #-} -- should parse even with BangPatterns enabled
+
+module T12862 where
+
+import Data.Kind (Type)
+
+class Key key where
+ data TotalMap key :: Type -> Type
+ (!) :: TotalMap key val -> (key -> val)
+
+instance Key Bool where
+ data TotalMap Bool val = BoolMap val val
+ (!) :: TotalMap Bool val -> (Bool -> val)
+ (BoolMap f _) ! False = f -- with parentheses
+ BoolMap f _ ! True = f -- without parentheses
=====================================
testsuite/tests/parser/should_compile/all.T
=====================================
@@ -172,3 +172,4 @@ test('T15730a', normal, compile_and_run, [''])
test('T18130', normal, compile, [''])
test('T18834a', normal, compile, [''])
test('T18834b', normal, compile, [''])
+test('T12862', normal, compile, [''])
=====================================
testsuite/tests/parser/should_fail/T12446.hs
=====================================
@@ -0,0 +1,3 @@
+module T12446 where
+
+x = undefined @(_ ~ _)
=====================================
testsuite/tests/parser/should_fail/T12446.stderr
=====================================
@@ -0,0 +1,4 @@
+
+T12446.hs:3:5: error:
+ Illegal visible type application ‘@(_ ~ _)’
+ Perhaps you intended to use TypeApplications
=====================================
testsuite/tests/parser/should_fail/all.T
=====================================
@@ -173,3 +173,4 @@ test('T18251c', normal, compile_fail, [''])
test('T18251d', normal, compile_fail, [''])
test('T18251e', normal, compile_fail, [''])
test('T18251f', normal, compile_fail, [''])
+test('T12446', normal, compile_fail, [''])
=====================================
testsuite/tests/patsyn/should_fail/T11010.stderr
=====================================
@@ -1,5 +1,5 @@
-T11010.hs:9:36: error:
+T11010.hs:9:34: error:
• Couldn't match type ‘a1’ with ‘Int’
Expected: a -> b
Actual: a1 -> b
@@ -12,3 +12,6 @@ T11010.hs:9:36: error:
• Relevant bindings include
x :: Expr a1 (bound at T11010.hs:9:36)
f :: a1 -> b (bound at T11010.hs:9:34)
+ |
+9 | pattern IntFun str f x = Fun str f x
+ | ^
=====================================
testsuite/tests/patsyn/should_fail/T18856.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
+
+module T18856 where
+
+pattern P :: Int -> Bool -> (Int, Bool, [(Bool,Bool)])
+pattern P p q <- (q, p, [(True,False)])
+
=====================================
testsuite/tests/patsyn/should_fail/T18856.stderr
=====================================
@@ -0,0 +1,14 @@
+
+T18856.hs:6:19: error:
+ • Couldn't match expected type ‘Bool’ with actual type ‘Int’
+ • In the declaration for pattern synonym ‘P’
+ |
+6 | pattern P p q <- (q, p, [(True,False)])
+ | ^
+
+T18856.hs:6:22: error:
+ • Couldn't match expected type ‘Int’ with actual type ‘Bool’
+ • In the declaration for pattern synonym ‘P’
+ |
+6 | pattern P p q <- (q, p, [(True,False)])
+ | ^
=====================================
testsuite/tests/patsyn/should_fail/all.T
=====================================
@@ -9,7 +9,7 @@ test('T9705-2', normal, compile_fail, [''])
test('unboxed-bind', normal, compile_fail, [''])
test('unboxed-wrapper-naked', normal, compile_fail, [''])
test('T10873', normal, compile_fail, [''])
-test('T11010', normal, compile_fail, [''])
+test('T11010', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('records-check-sels', normal, compile_fail, [''])
test('records-no-uni-update', normal, compile_fail, [''])
test('records-no-uni-update2', normal, compile_fail, [''])
@@ -47,3 +47,4 @@ test('T15692', normal, compile, ['']) # It has -fdefer-type-errors inside
test('T15694', normal, compile_fail, [''])
test('T16900', normal, compile_fail, ['-fdiagnostics-show-caret'])
test('T14552', normal, compile_fail, [''])
+test('T18856', normal, compile_fail, ['-fdiagnostics-show-caret'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ed84df27aa043c016c69b3e225931cf5710491d...d963882ed1c55f262bbc93f30fbc7a636d1d908b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6ed84df27aa043c016c69b3e225931cf5710491d...d963882ed1c55f262bbc93f30fbc7a636d1d908b
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201026/8779c90c/attachment-0001.html>
More information about the ghc-commits
mailing list