260 lines
5.8 KiB
Diff
260 lines
5.8 KiB
Diff
--- 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 -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)
|
|
+}
|