path: root/dev-haskell/happy/files/happy-1.18.9-missing-tests.patch

--- happy-1.18.9-orig/happy.cabal	2012-02-06 20:49:56.000000000 +1100
+++ happy-1.18.9/happy.cabal	2012-02-07 20:50:33.859004968 +1100
@@ -100,10 +100,13 @@
 	templates/GLR_Base.hs
 	templates/GenericTemplate.hs
 	templates/GLR_Lib.hs
+	tests/AttrGrammar001.y
+	tests/AttrGrammar002.y
 	tests/error001.y
 	tests/error001.stdout
 	tests/error001.stderr
 	tests/monad001.y
+	tests/monaderror.y
 	tests/Makefile
 	tests/TestMulti.ly
 	tests/Partial.ly
--- happy-1.18.9-orig/tests/Makefile	2012-02-06 20:49:55.000000000 +1100
+++ happy-1.18.9/tests/Makefile	2012-02-07 20:50:33.859004968 +1100
@@ -1,5 +1,5 @@
 HAPPY=../dist/build/happy/happy
-HC=ghc
+HC=ghc -hide-all-packages -package base -package array -package mtl
 
 TESTS = Test.ly TestMulti.ly TestPrecedence.ly bug001.ly \
 	monad001.y monad002.ly precedence001.ly precedence002.y \
--- /dev/null	2012-02-07 10:04:42.144206507 +1100
+++ happy-1.18.9/tests/AttrGrammar001.y	2012-02-07 20:50:47.013316418 +1100
@@ -0,0 +1,68 @@
+{
+import Control.Monad (unless)
+}
+
+%tokentype { Char }
+
+%token a { 'a' }
+%token b { 'b' }
+%token c { 'c' }
+
+%attributetype { Attrs a }
+%attribute value { a }
+%attribute len   { Int }
+
+%name parse abcstring
+
+%monad { Maybe }
+
+%%
+
+abcstring 
+   : alist blist clist
+        { $$ = $1 ++ $2 ++ $3
+        ; $2.len = $1.len
+        ; $3.len = $1.len
+        }
+
+alist 
+   : a alist 
+        { $$ = $1 : $>
+        ; $$.len = $>.len + 1
+        }
+   |    { $$ = []; $$.len = 0 }
+
+blist 
+   : b blist
+        { $$ = $1 : $>
+        ; $>.len = $$.len - 1
+        }
+   |    { $$ = []
+        ; where failUnless ($$.len == 0) "blist wrong length" 
+        }
+
+clist
+   : c clist
+        { $$ = $1 : $>
+        ; $>.len = $$.len - 1
+        }
+   |    { $$ = []
+        ; where failUnless ($$.len == 0) "clist wrong length" 
+        }
+
+{
+happyError = error "parse error"
+failUnless b msg = unless b (fail msg)
+
+main = case parse "" of { Just _ -> 
+       case parse "abc" of { Just _ ->
+       case parse "aaaabbbbcccc" of { Just _ ->
+       case parse "abbcc" of { Nothing ->
+       case parse "aabcc" of { Nothing ->
+       case parse "aabbc" of { Nothing ->
+       putStrLn "Test works";
+       _ -> quit } ; _ -> quit }; _ -> quit };
+       _ -> quit } ; _ -> quit }; _ -> quit }
+
+quit = putStrLn "Test failed"
+}
--- /dev/null	2012-02-07 10:04:42.144206507 +1100
+++ happy-1.18.9/tests/AttrGrammar002.y	2012-02-07 20:50:47.013316418 +1100
@@ -0,0 +1,58 @@
+
+%tokentype { Char }
+
+%token minus { '-' }
+%token plus  { '+' }
+%token one   { '1' }
+%token zero  { '0' }
+
+%attributetype { Attrs }
+%attribute value { Integer }
+%attribute pos   { Int }
+
+%name parse start
+
+%monad { Maybe }
+
+%%
+
+start 
+   : num { $$ = $1 }
+
+num 
+   : bits        { $$ = $1       ; $1.pos = 0 }
+   | plus bits   { $$ = $2       ; $2.pos = 0 }
+   | minus bits  { $$ = negate $2; $2.pos = 0 }
+
+bits
+   : bit         { $$ = $1
+                 ; $1.pos = $$.pos 
+                 }
+
+   | bits bit    { $$ = $1 + $2
+                 ; $1.pos = $$.pos + 1
+                 ; $2.pos = $$.pos
+                 }
+
+bit
+   : zero        { $$ = 0 }
+   | one         { $$ = 2^($$.pos) }
+
+
+{
+happyError msg = fail $ "parse error: "++msg
+
+main = case parse ""      of { Nothing ->
+       case parse "abc"   of { Nothing ->
+       case parse "0"     of { Just 0  ->
+       case parse "1"     of { Just 1  ->
+       case parse "101"   of { Just 5  ->
+       case parse "111"   of { Just 7  ->
+       case parse "10001" of { Just 17 ->
+       putStrLn "Test worked";
+       _ -> quit }; _ -> quit }; _ -> quit };
+       _ -> quit }; _ -> quit }; _ -> quit };
+       _ -> quit }
+
+quit = putStrLn "Test Failed"
+}
--- /dev/null	2012-02-07 10:04:42.144206507 +1100
+++ happy-1.18.9/tests/ParGF.y	2012-02-07 20:50:47.014316443 +1100
@@ -0,0 +1,40 @@
+{-
+
+With Happy 1.17 this file produces "Internal Happy error" when run:
+
+$ happy ParGF.y && runghc ParGF.hs
+ParGF.hs: Internal Happy error
+
+The problem is that we always pass around the "current token".  When not
+using %lexer and we've run out of tokens, the current token is notHappyAtAll,
+which gets passed to happyError when there's an error.
+
+-}
+
+{
+}
+
+%name pGrammar
+
+%tokentype { String }
+%error { parseError }
+
+%token 
+ 'a' { "a" }
+
+%%
+
+Grammar :: { () }
+Grammar :  'a' 'a' { () } 
+
+{
+
+parseError :: [String] -> a
+-- commenting out the below line gets rid of the "Internal Happy Error"
+parseError ("":_) = error "bar"
+parseError _ = error "foo"
+
+main :: IO ()
+main = print $ pGrammar ["a"]
+
+}
--- /dev/null	2012-02-07 10:04:42.144206507 +1100
+++ happy-1.18.9/tests/monaderror.y	2012-02-07 20:50:47.015316467 +1100
@@ -0,0 +1,57 @@
+{
+module Main where
+
+import Data.Char
+import Control.Monad.Error
+import System.Exit
+}
+
+%name parseFoo
+%tokentype { Token }
+%error { handleError }
+
+%monad { ParseM } { (>>=) } { return }
+
+%token
+        'S'             { TokenSucc }
+        'Z'             { TokenZero }
+
+%%
+
+Exp         :       'Z'         { 0 }
+            |       'S' Exp     { $2 + 1 }
+
+{
+
+type ParseM a = Either ParseError a
+data ParseError
+        = ParseError (Maybe Token)
+        | StringError String
+    deriving (Eq,Show)
+instance Error ParseError where
+    strMsg = StringError
+
+data Token
+        = TokenSucc
+        | TokenZero
+    deriving (Eq,Show)
+
+handleError :: [Token] -> ParseM a
+handleError [] = throwError $ ParseError Nothing
+handleError ts = throwError $ ParseError $ Just $ head ts
+
+lexer :: String -> [Token]
+lexer [] = []
+lexer (c:cs)
+    | isSpace c = lexer cs
+    | c == 'S'  = TokenSucc:(lexer cs)
+    | c == 'Z'  = TokenZero:(lexer cs)
+    | otherwise = error "lexer error"
+
+main :: IO ()
+main = do
+    let tokens = lexer "S S"
+    when (parseFoo tokens /= Left (ParseError Nothing)) $ do
+        print (parseFoo tokens)
+        exitWith (ExitFailure 1)
+}