Fix #11624, cannot declare hs-boot if already one in scope.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 11 Mar 2016 09:37:26 +0000 (10:37 +0100)
committerBen Gamari <ben@smart-cactus.org>
Fri, 11 Mar 2016 09:47:57 +0000 (10:47 +0100)
I'm not sure if this fix is the "right way" to do it, but
it solves the proximal problem, which is that lookupBindGroupOcc
was picking out the wrong renaming for hs-boot signatures,
which then lead to an interface file error.

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: simonpj, hvr, austin, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1963

GHC Trac Issues: #11624

compiler/rename/RnBinds.hs
compiler/rename/RnEnv.hs
compiler/rename/RnSource.hs
testsuite/tests/driver/sigof02/all.T
testsuite/tests/driver/sigof02/sigof02dmt.stderr
testsuite/tests/driver/sigof02/sigof02dt.stderr
testsuite/tests/rename/should_compile/T11624.hs [new file with mode: 0644]
testsuite/tests/rename/should_compile/T11624.hs-boot [new file with mode: 0644]
testsuite/tests/rename/should_compile/T11624.stderr [new file with mode: 0644]
testsuite/tests/rename/should_compile/T11624a.hs [new file with mode: 0644]
testsuite/tests/rename/should_compile/all.T

index 2f7e808..76a13f7 100644 (file)
@@ -11,7 +11,7 @@ they may be affected by renaming (which isn't fully worked out yet).
 
 module RnBinds (
    -- Renaming top-level bindings
-   rnTopBindsLHS, rnTopBindsRHS, rnValBindsRHS,
+   rnTopBindsLHS, rnTopBindsBoot, rnValBindsRHS,
 
    -- Renaming local bindings
    rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
@@ -168,22 +168,14 @@ rnTopBindsLHS :: MiniFixityEnv
 rnTopBindsLHS fix_env binds
   = rnValBindsLHS (topRecNameMaker fix_env) binds
 
-rnTopBindsRHS :: NameSet -> HsValBindsLR Name RdrName
-              -> RnM (HsValBinds Name, DefUses)
-rnTopBindsRHS bound_names binds
-  = do { is_boot <- tcIsHsBootOrSig
-       ; if is_boot
-         then rnTopBindsBoot binds
-         else rnValBindsRHS (TopSigCtxt bound_names) binds }
-
-rnTopBindsBoot :: HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
+rnTopBindsBoot :: NameSet -> HsValBindsLR Name RdrName -> RnM (HsValBinds Name, DefUses)
 -- A hs-boot file has no bindings.
 -- Return a single HsBindGroup with empty binds and renamed signatures
-rnTopBindsBoot (ValBindsIn mbinds sigs)
+rnTopBindsBoot bound_names (ValBindsIn mbinds sigs)
   = do  { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
-        ; (sigs', fvs) <- renameSigs HsBootCtxt sigs
+        ; (sigs', fvs) <- renameSigs (HsBootCtxt bound_names) sigs
         ; return (ValBindsOut [] sigs', usesOnly fvs) }
-rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)
+rnTopBindsBoot b = pprPanic "rnTopBindsBoot" (ppr b)
 
 {-
 *********************************************************
@@ -959,8 +951,8 @@ okHsSig ctxt (L _ sig)
      (IdSig {}, InstDeclCtxt {}) -> True
      (IdSig {}, _)               -> False
 
-     (InlineSig {}, HsBootCtxt) -> False
-     (InlineSig {}, _)          -> True
+     (InlineSig {}, HsBootCtxt {}) -> False
+     (InlineSig {}, _)             -> True
 
      (SpecSig {}, TopSigCtxt {})    -> True
      (SpecSig {}, LocalBindCtxt {}) -> True
index 0ecd85e..a2fd926 100644 (file)
@@ -1228,7 +1228,7 @@ data HsSigCtxt
   | ClsDeclCtxt   Name       -- Class decl for this class
   | InstDeclCtxt  NameSet    -- Instance decl whose user-written method
                              -- bindings are for these methods
-  | HsBootCtxt               -- Top level of a hs-boot file
+  | HsBootCtxt NameSet       -- Top level of a hs-boot file, binding these names
   | RoleAnnotCtxt NameSet    -- A role annotation, with the names of all types
                              -- in the group
 
@@ -1270,7 +1270,7 @@ lookupBindGroupOcc ctxt what rdr_name
 
   | otherwise
   = case ctxt of
-      HsBootCtxt       -> lookup_top (const True)
+      HsBootCtxt ns    -> lookup_top (`elemNameSet` ns)
       TopSigCtxt ns    -> lookup_top (`elemNameSet` ns)
       RoleAnnotCtxt ns -> lookup_top (`elemNameSet` ns)
       LocalBindCtxt ns -> lookup_group ns
index 012e117..67afee7 100644 (file)
@@ -152,7 +152,13 @@ rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
    -- (F) Rename Value declarations right-hand sides
    traceRn (text "Start rnmono") ;
    let { val_bndr_set = mkNameSet id_bndrs `unionNameSet` mkNameSet pat_syn_bndrs } ;
-   (rn_val_decls, bind_dus) <- rnTopBindsRHS val_bndr_set new_lhs ;
+   is_boot <- tcIsHsBootOrSig ;
+   (rn_val_decls, bind_dus) <- if is_boot
+    -- For an hs-boot, use tc_bndrs (which collects how we're renamed
+    -- signatures), since val_bndr_set is empty (there are no x = ...
+    -- bindings in an hs-boot.)
+    then rnTopBindsBoot tc_bndrs new_lhs
+    else rnValBindsRHS (TopSigCtxt val_bndr_set) new_lhs ;
    traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
 
    -- (G) Rename Fixity and deprecations
index 68c08ef..76cec88 100644 (file)
@@ -4,7 +4,7 @@ test('sigof02',
      ['$MAKE -s --no-print-directory sigof02'])
 
 test('sigof02t',
-     [ expect_broken(10472), clean_cmd('rm -rf tmp_sigof02t') ],
+     [ clean_cmd('rm -rf tmp_sigof02t') ],
      run_command,
      ['$MAKE -s --no-print-directory sigof02t'])
 
@@ -14,7 +14,7 @@ test('sigof02m',
      ['$MAKE -s --no-print-directory sigof02m'])
 
 test('sigof02mt',
-     [ expect_broken(10472), clean_cmd('rm -rf tmp_sigof02mt') ],
+     [ clean_cmd('rm -rf tmp_sigof02mt') ],
      run_command,
      ['$MAKE -s --no-print-directory sigof02mt'])
 
@@ -24,7 +24,7 @@ test('sigof02d',
      ['$MAKE -s --no-print-directory sigof02d'])
 
 test('sigof02dt',
-     [ expect_broken(10472), clean_cmd('rm -rf tmp_sigof02dt') ],
+     [ clean_cmd('rm -rf tmp_sigof02dt') ],
      run_command,
      ['$MAKE -s --no-print-directory sigof02dt'])
 
@@ -35,7 +35,7 @@ test('sigof02dm',
      ['$MAKE -s --no-print-directory sigof02dm'])
 
 test('sigof02dmt',
-     [ expect_broken(10472), clean_cmd('rm -rf tmp_sigof02dmt') ],
+     [ clean_cmd('rm -rf tmp_sigof02dmt') ],
      run_command,
      ['$MAKE -s --no-print-directory sigof02dmt'])
 
index 1da0449..389c7b7 100644 (file)
@@ -1,8 +1,9 @@
 
-Double.hs:11:20:
-    Couldn't match expected type ‘MapAsSet.Map k0 a0’
-                with actual type ‘Map.Map Int [Char]’
-    NB: ‘MapAsSet.Map’ is defined at MapAsSet.hsig:7:1-12
-        ‘Map.Map’ is defined at Map.hsig:15:1-12
-    In the first argument of ‘keysSet’, namely ‘x’
-    In the first argument of ‘print’, namely ‘(keysSet x)’
+Double.hs:11:20: error:
+    • Couldn't match expected type ‘MapAsSet.Map k0 a0’
+                  with actual type ‘Map.Map Int [Char]’
+      NB: ‘Map.Map’ is defined at Map.hsig:15:1-12
+          ‘MapAsSet.Map’ is defined at MapAsSet.hsig:7:1-12
+    • In the first argument of ‘keysSet’, namely ‘x’
+      In the first argument of ‘print’, namely ‘(keysSet x)’
+      In a stmt of a 'do' block: print (keysSet x)
index 227a34f..5b23583 100644 (file)
@@ -1,8 +1,9 @@
 
-Double.hs:11:20:
-    Couldn't match expected type ‘MapAsSet.Map k0 a0’
-                with actual type ‘Map.Map Int [Char]’
-    NB: ‘MapAsSet.Map’ is defined in ‘MapAsSet’
-        ‘Map.Map’ is defined in ‘Map’
-    In the first argument of ‘keysSet’, namely ‘x’
-    In the first argument of ‘print’, namely ‘(keysSet x)’
+Double.hs:11:20: error:
+    • Couldn't match expected type ‘MapAsSet.Map k0 a0’
+                  with actual type ‘Map.Map Int [Char]’
+      NB: ‘Map.Map’ is defined in ‘Map’
+          ‘MapAsSet.Map’ is defined in ‘MapAsSet’
+    • In the first argument of ‘keysSet’, namely ‘x’
+      In the first argument of ‘print’, namely ‘(keysSet x)’
+      In a stmt of a 'do' block: print (keysSet x)
diff --git a/testsuite/tests/rename/should_compile/T11624.hs b/testsuite/tests/rename/should_compile/T11624.hs
new file mode 100644 (file)
index 0000000..51567a6
--- /dev/null
@@ -0,0 +1,4 @@
+module T11624 where
+import T11624a
+concat :: Int -> Int
+concat n = n + 2
diff --git a/testsuite/tests/rename/should_compile/T11624.hs-boot b/testsuite/tests/rename/should_compile/T11624.hs-boot
new file mode 100644 (file)
index 0000000..f993dff
--- /dev/null
@@ -0,0 +1,3 @@
+module T11624 where
+import Prelude(concat, Int)
+concat :: Int -> Int
diff --git a/testsuite/tests/rename/should_compile/T11624.stderr b/testsuite/tests/rename/should_compile/T11624.stderr
new file mode 100644 (file)
index 0000000..9cde014
--- /dev/null
@@ -0,0 +1,3 @@
+[1 of 3] Compiling T11624[boot]     ( T11624.hs-boot, T11624.o-boot )
+[2 of 3] Compiling T11624a          ( T11624a.hs, T11624a.o )
+[3 of 3] Compiling T11624           ( T11624.hs, T11624.o )
diff --git a/testsuite/tests/rename/should_compile/T11624a.hs b/testsuite/tests/rename/should_compile/T11624a.hs
new file mode 100644 (file)
index 0000000..1e95748
--- /dev/null
@@ -0,0 +1,4 @@
+module T11624a where
+import {-# SOURCE #-} T11624
+import Prelude ()
+x = concat 3
index ede9f19..a15146b 100644 (file)
@@ -233,6 +233,7 @@ test('T11164',
 test('T11167', normal, compile, [''])
 test('T11167_ambig', normal, compile, [''])
 test('T10625', normal, compile, [''])
+test('T11624', extra_clean(['T11624a.hi', 'T11624a.o', 'T11624.hi-boot', 'T11624.o-boot']), multimod_compile, ['T11624', ''])
 test('T11662',
      [extra_clean(['T11662_A.hi', 'T11662_A.o'])],
      multimod_compile,