[commit: testsuite] master: Fix fallout from making lazy unlifted bindings an error (cdadf54)

git at git.haskell.org git at git.haskell.org
Mon Sep 30 00:23:59 CEST 2013


Repository : ssh://git@git.haskell.org/testsuite

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cdadf54025e1b854fea17ca928566b8a00636c0c/testsuite

>---------------------------------------------------------------

commit cdadf54025e1b854fea17ca928566b8a00636c0c
Author: Austin Seipp <austin at well-typed.com>
Date:   Sun Sep 29 17:22:22 2013 -0500

    Fix fallout from making lazy unlifted bindings an error
    
    Issue #8022
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

cdadf54025e1b854fea17ca928566b8a00636c0c
 tests/ghci.debugger/HappyTest.hs             |    8 +++----
 tests/ghci.debugger/scripts/print020.stderr  |   31 --------------------------
 tests/typecheck/should_fail/T2806.hs         |    1 -
 tests/typecheck/should_fail/T2806.stderr     |    5 +----
 tests/typecheck/should_fail/all.T            |    2 +-
 tests/typecheck/should_fail/tcfail203.stderr |    8 +++----
 6 files changed, 10 insertions(+), 45 deletions(-)

diff --git a/tests/ghci.debugger/HappyTest.hs b/tests/ghci.debugger/HappyTest.hs
index 62b055f..02c6a96 100644
--- a/tests/ghci.debugger/HappyTest.hs
+++ b/tests/ghci.debugger/HappyTest.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, MagicHash #-}
+{-# LANGUAGE CPP, MagicHash, BangPatterns #-}
 import Data.Char
 import Data.Array
 import GHC.Exts
@@ -416,7 +416,7 @@ happyReduce k i fn 0# tk st sts stk
      = happyFail 0# tk st sts stk
 happyReduce k nt fn j tk st sts stk
      = case happyDrop (k -# (1# :: Int#)) sts of
-	 sts1@((HappyCons (st1@(action)) (_))) ->
+	 !sts1@((HappyCons (st1@(action)) (_))) ->
         	let r = fn stk in  -- it doesn't hurt to always seq here...
        		happyDoSeq r (happyGoto nt j tk st1 sts1 r)
 
@@ -424,14 +424,14 @@ happyMonadReduce k nt fn 0# tk st sts stk
      = happyFail 0# tk st sts stk
 happyMonadReduce k nt fn j tk st sts stk =
         happyThen1 (fn stk tk) (\r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
-       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+       where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
              drop_stk = happyDropStk k stk
 
 happyMonad2Reduce k nt fn 0# tk st sts stk
      = happyFail 0# tk st sts stk
 happyMonad2Reduce k nt fn j tk st sts stk =
        happyThen1 (fn stk tk) (\r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
-       where sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
+       where !sts1@((HappyCons (st1@(action)) (_))) = happyDrop k (HappyCons (st) (sts))
              drop_stk = happyDropStk k stk
 
              off    = indexShortOffAddr happyGotoOffsets st1
diff --git a/tests/ghci.debugger/scripts/print020.stderr b/tests/ghci.debugger/scripts/print020.stderr
index 6642bb7..e69de29 100644
--- a/tests/ghci.debugger/scripts/print020.stderr
+++ b/tests/ghci.debugger/scripts/print020.stderr
@@ -1,31 +0,0 @@
-
-GenericTemplate.hs:219:14: Warning:
-    Pattern bindings containing unlifted types should use an outermost bang pattern:
-      sts1@((HappyCons (st1@(action)) (_)))
-        = happyDrop k (HappyCons (st) (sts))
-    In an equation for ‛happyMonadReduce’:
-        happyMonadReduce k nt fn j tk st sts stk
-          = happyThen1
-              (fn stk tk)
-              (\ r -> happyGoto nt j tk st1 sts1 (r `HappyStk` drop_stk))
-          where
-              sts1@((HappyCons (st1@(action)) (_)))
-                = happyDrop k (HappyCons (st) (sts))
-              drop_stk = happyDropStk k stk
-
-GenericTemplate.hs:226:14: Warning:
-    Pattern bindings containing unlifted types should use an outermost bang pattern:
-      sts1@((HappyCons (st1@(action)) (_)))
-        = happyDrop k (HappyCons (st) (sts))
-    In an equation for ‛happyMonad2Reduce’:
-        happyMonad2Reduce k nt fn j tk st sts stk
-          = happyThen1
-              (fn stk tk)
-              (\ r -> happyNewToken new_state sts1 (r `HappyStk` drop_stk))
-          where
-              sts1@((HappyCons (st1@(action)) (_)))
-                = happyDrop k (HappyCons (st) (sts))
-              drop_stk = happyDropStk k stk
-              off = indexShortOffAddr happyGotoOffsets st1
-              off_i = (off +# nt)
-              ....
diff --git a/tests/typecheck/should_fail/T2806.hs b/tests/typecheck/should_fail/T2806.hs
index a130d49..6ada5d8 100644
--- a/tests/typecheck/should_fail/T2806.hs
+++ b/tests/typecheck/should_fail/T2806.hs
@@ -1,6 +1,5 @@
 
 {-# LANGUAGE MagicHash #-}
-{-# OPTIONS_GHC -Werror #-}
 
 -- Trac #2806
 
diff --git a/tests/typecheck/should_fail/T2806.stderr b/tests/typecheck/should_fail/T2806.stderr
index da35b20..b0130e2 100644
--- a/tests/typecheck/should_fail/T2806.stderr
+++ b/tests/typecheck/should_fail/T2806.stderr
@@ -1,5 +1,5 @@
 
-T2806.hs:13:11: Warning:
+T2806.hs:12:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (I# _x) = 4
     In an equation for ‛foo’:
@@ -7,6 +7,3 @@ T2806.hs:13:11: Warning:
           = 3
           where
               (I# _x) = 4
-
-<no location info>: 
-Failing due to -Werror.
diff --git a/tests/typecheck/should_fail/all.T b/tests/typecheck/should_fail/all.T
index 1e7472d..cac7d92 100644
--- a/tests/typecheck/should_fail/all.T
+++ b/tests/typecheck/should_fail/all.T
@@ -189,7 +189,7 @@ test('tcfail199', normal, compile_fail, [''])
 test('tcfail200', normal, compile_fail, [''])
 test('tcfail201', normal, compile_fail, [''])
 test('tcfail202', normal, compile_fail, [''])
-test('tcfail203', normal, compile, [''])
+test('tcfail203', normal, compile_fail, [''])
 test('tcfail203a', normal, compile_fail, [''])
 test('tcfail204', normal, compile_fail, [''])
 test('tcfail206', normal, compile_fail, [''])
diff --git a/tests/typecheck/should_fail/tcfail203.stderr b/tests/typecheck/should_fail/tcfail203.stderr
index 7635b68..e1a00c3 100644
--- a/tests/typecheck/should_fail/tcfail203.stderr
+++ b/tests/typecheck/should_fail/tcfail203.stderr
@@ -1,5 +1,5 @@
 
-tcfail203.hs:28:11: Warning:
+tcfail203.hs:28:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (I# x) = 5
     In an equation for ‛fail2’:
@@ -8,7 +8,7 @@ tcfail203.hs:28:11: Warning:
           where
               (I# x) = 5
 
-tcfail203.hs:31:11: Warning:
+tcfail203.hs:31:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (b, I# x) = (True, 5)
     In an equation for ‛fail3’:
@@ -17,7 +17,7 @@ tcfail203.hs:31:11: Warning:
           where
               (b, I# x) = (True, 5)
 
-tcfail203.hs:40:11: Warning:
+tcfail203.hs:40:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (I# !x) = 5
     In an equation for ‛fail6’:
@@ -26,7 +26,7 @@ tcfail203.hs:40:11: Warning:
           where
               (I# !x) = 5
 
-tcfail203.hs:43:11: Warning:
+tcfail203.hs:43:11:
     Pattern bindings containing unlifted types should use an outermost bang pattern:
       (b, !(I# x)) = (True, 5)
     In an equation for ‛fail7’:




More information about the ghc-commits mailing list