summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreyChudnov <>2013-06-23 02:38:51 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-06-23 02:38:51 (GMT)
commitd92bec9fcfe3d184fc6334fa73cdc0b1b8800b27 (patch)
tree11cc0d8e67344271b07a7a23c295cd435180c851
parent567b6e04b347fa81c7e12bc20dbab47fd8aa4dc9 (diff)
version 0.150.15
-rw-r--r--CHANGELOG10
-rw-r--r--language-ecmascript.cabal70
-rw-r--r--src/Language/ECMAScript3/Analysis/Environment.hs2
-rw-r--r--src/Language/ECMAScript3/Analysis/LabelSets.hs7
-rw-r--r--src/Language/ECMAScript3/Parser.hs71
-rw-r--r--src/Language/ECMAScript3/Parser/Type.hs4
-rw-r--r--src/Language/ECMAScript3/PrettyPrint.hs21
-rw-r--r--src/Language/ECMAScript3/SourceDiff.hs24
-rw-r--r--src/Language/ECMAScript3/Syntax.hs5
-rw-r--r--src/Language/ECMAScript3/Syntax/Arbitrary.hs14
-rw-r--r--src/Language/ECMAScript3/Syntax/QuasiQuote.hs6
-rw-r--r--src/PrettyTest.hs29
-rw-r--r--src/UnitTest.hs33
-rw-r--r--test/Test/Diff.hs58
-rw-r--r--test/Test/Pretty.hs43
-rw-r--r--test/Test/Unit.hs49
-rw-r--r--test/TestMain.hs12
-rw-r--r--test/diff/expects/t1.diff2
-rw-r--r--test/diff/left/t1.js2
-rw-r--r--test/diff/right/t1.js1
-rw-r--r--test/parse-pretty/add.js (renamed from tests/parse-pretty/add.js)0
-rw-r--r--test/parse-pretty/do-while.js (renamed from tests/parse-pretty/do-while.js)0
-rw-r--r--test/parse-pretty/flapjax-fxinternal-22dec2008.js (renamed from tests/parse-pretty/flapjax-fxinternal-22dec2008.js)0
-rw-r--r--test/parse-pretty/neg.js (renamed from tests/parse-pretty/neg.js)0
-rw-r--r--test/parse-pretty/numbers.js (renamed from tests/parse-pretty/numbers.js)0
-rw-r--r--test/parse-pretty/object-lit-1.js (renamed from tests/parse-pretty/object-lit-1.js)0
-rw-r--r--test/parse-pretty/object-lit-2.js (renamed from tests/parse-pretty/object-lit-2.js)0
-rw-r--r--test/parse-pretty/prefix-chain.js (renamed from tests/parse-pretty/prefix-chain.js)0
-rw-r--r--test/parse-pretty/strings.js (renamed from tests/parse-pretty/strings.js)0
29 files changed, 333 insertions, 130 deletions
diff --git a/CHANGELOG b/CHANGELOG
index 302b931..05c323f 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,5 +1,15 @@
Version change log.
+=0.15=
+Bug fixes in the pretty-printer, the parser and the QuickCheck arbitrary
+instance for the AST. Refactored tests to use test-framework. Reorganized
+the interface for the parser to make it consistent; see deprecation
+warnings for details. Added Language.ECMAScript3.SourceDiff -- a simple
+source-based differ for ECMAScript programs, which is now used for
+visualizing test failures. Revised package dependencies. Factored the
+analyses out in a separate package: language-ecmascript-analysis;
+Language.ECMAScript3.Analysis.* are now deprecated.
+
=0.14=
Refactoring of the pretty-printing module: added class Pretty with a more
comprehensive coverage of AST datatypes and better documentation. Removed
diff --git a/language-ecmascript.cabal b/language-ecmascript.cabal
index 20e02a7..c2c202a 100644
--- a/language-ecmascript.cabal
+++ b/language-ecmascript.cabal
@@ -1,5 +1,5 @@
Name: language-ecmascript
-Version: 0.14
+Version: 0.15
Cabal-Version: >= 1.10
Copyright: (c) 2007-2012 Brown University, (c) 2008-2010 Claudiu Saftoiu,
(c) 2012-2013 Stevens Institute of Technology
@@ -11,15 +11,17 @@ Maintainer: Andrey Chudnov <oss@chudnov.com>
Homepage: http://github.com/jswebtools/language-ecmascript
Bug-reports: http://github.com/jswebtools/language-ecmascript/issues
Stability: experimental
-Tested-with: GHC==7.4.1, GHC==7.6.3
-Extra-Source-Files: tests/parse-pretty/*.js, CHANGELOG
+Tested-with: GHC==7.6.3
+Extra-Source-Files: test/parse-pretty/*.js, test/diff/left/*.js, test/diff/right/*.js, test/diff/expects/*.diff, CHANGELOG
Category: Language
Build-Type: Simple
-Synopsis: JavaScript analysis tools
+Synopsis: JavaScript parser and pretty-printer library
Description:
- Some tools for working with ECMAScript 3 (popularly known as JavaScript).
- Includes a parser, pretty-printer, and basic building blocks for more
- sophisticated tools.
+ Tools for working with ECMAScript 3 (popularly known as JavaScript).
+ Includes a parser, pretty-printer, a simple quasi-quoter and tools
+ for working with source tree annotations and an arbitrary
+ instance. Analyses have migrated to package
+ 'language-ecmascript-analysis'.
Source-repository head
type: git
@@ -28,7 +30,7 @@ Source-repository head
Source-repository this
type: git
location: git://github.com/jswebtools/language-ecmascript.git
- tag: 0.14
+ tag: 0.15
Library
Hs-Source-Dirs:
@@ -39,12 +41,11 @@ Library
parsec < 3.2.0,
pretty >= 0.1,
containers >= 0.1,
- syb >= 0.1,
uniplate >= 1.6 && <1.7,
- data-default >= 0.4 && <0.6,
+ data-default-class >= 0.0.1 && < 0.1,
QuickCheck >= 2.5,
template-haskell,
- charset >= 0.3.2.1
+ Diff == 0.3.*
ghc-options:
-fwarn-incomplete-patterns
Exposed-Modules:
@@ -58,52 +59,39 @@ Library
Language.ECMAScript3.Syntax.QuasiQuote
Language.ECMAScript3.Analysis.Environment
Language.ECMAScript3.Analysis.LabelSets
+ Language.ECMAScript3.SourceDiff
+ Other-Modules:
Language.ECMAScript3.Parser.Type
Language.ECMAScript3.Parser.State
Default-Extensions:
DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts
Default-Language: Haskell2010
-Test-Suite unittest
- Hs-Source-Dirs: src
+Test-Suite test
+ Hs-Source-Dirs: test
Type: exitcode-stdio-1.0
- Main-Is: UnitTest.hs
+ Main-Is: TestMain.hs
+ Other-Modules:
+ Test.Diff
+ Test.Unit
+ Test.Pretty
Build-Depends:
base >= 4 && < 5,
mtl >= 1.1.0.1,
parsec < 3.2.0,
pretty >= 0.1,
- containers >= 0.1,
- syb >= 0.1,
+ containers >= 0.1 && < 0.6,
directory,
filepath,
HUnit,
- data-default >=0.4 && <0.6,
- QuickCheck >= 2.5,
- charset >= 0.3.2.1
+ QuickCheck >= 2.5 && < 2.6,
+ data-default-class >= 0.0.1 && < 0.1,
+ test-framework >= 0.8 && < 0.9,
+ test-framework-hunit >= 0.3.0 && < 0.4,
+ test-framework-quickcheck2 >= 0.3.0.1 && < 0.4,
+ Diff == 0.3.*,
+ language-ecmascript
Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts
Default-Language: Haskell2010
ghc-options:
-fwarn-incomplete-patterns
-
-Test-Suite prettytest
- Hs-Source-Dirs: src
- Type: exitcode-stdio-1.0
- Main-Is: PrettyTest.hs
- Build-Depends:
- base >= 4 && < 5,
- mtl >= 1.1.0.1,
- parsec < 3.2.0,
- pretty >= 0.1,
- containers >= 0.1,
- syb >= 0.1,
- directory,
- filepath,
- HUnit,
- data-default >=0.4 && <0.6,
- QuickCheck >= 2.5,
- uniplate >= 1.6 && <1.7
- Default-Extensions: DeriveDataTypeable, ScopedTypeVariables, DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts
- Default-Language: Haskell2010
- ghc-options:
- -fwarn-incomplete-patterns \ No newline at end of file
diff --git a/src/Language/ECMAScript3/Analysis/Environment.hs b/src/Language/ECMAScript3/Analysis/Environment.hs
index 13b51f2..68c7965 100644
--- a/src/Language/ECMAScript3/Analysis/Environment.hs
+++ b/src/Language/ECMAScript3/Analysis/Environment.hs
@@ -1,6 +1,8 @@
-- | A lexical environment analysis of ECMAScript programs
module Language.ECMAScript3.Analysis.Environment
+ {-# DEPRECATED "Use 'Language.ECMAScript.Analysis.LexicalEnvironment'\
+ \ from package 'language-ecmascript-analysis'" #-}
( env
, localVars
, EnvTree (..)
diff --git a/src/Language/ECMAScript3/Analysis/LabelSets.hs b/src/Language/ECMAScript3/Analysis/LabelSets.hs
index 9f99db1..abf2e42 100644
--- a/src/Language/ECMAScript3/Analysis/LabelSets.hs
+++ b/src/Language/ECMAScript3/Analysis/LabelSets.hs
@@ -3,8 +3,11 @@
-- section 12.12. The result of this analysis are useful for building
-- control-flow graphs.
-module Language.ECMAScript3.Analysis.LabelSets (annotateLabelSets
- ,Label(..)) where
+module Language.ECMAScript3.Analysis.LabelSets
+ {-# DEPRECATED "Use 'Language.ECMAScript3.Analysis.LabelSet'\
+ \ from package 'language-ecmascript-analysis'" #-}
+ (annotateLabelSets
+ ,Label(..)) where
import Language.ECMAScript3.Syntax
import Language.ECMAScript3.Syntax.Annotations
diff --git a/src/Language/ECMAScript3/Parser.hs b/src/Language/ECMAScript3/Parser.hs
index 3e486c7..f54971e 100644
--- a/src/Language/ECMAScript3/Parser.hs
+++ b/src/Language/ECMAScript3/Parser.hs
@@ -2,6 +2,13 @@
{-# LANGUAGE FlexibleContexts #-}
module Language.ECMAScript3.Parser
(parse
+ , Parser
+ , expression
+ , statement
+ , program
+ , parseFromString
+ , parseFromFile
+ -- old and deprecated
, parseScriptFromString
, parseJavaScriptFromFile
, parseScript
@@ -15,11 +22,7 @@ module Language.ECMAScript3.Parser
, StatementParser
, ExpressionParser
, assignExpr
- -- debugging, remove the next 2 lines
- , mkDecimal
- , intLen
, parseObjectLit
- , Parser
) where
import Language.ECMAScript3.Lexer hiding (identifier)
@@ -28,7 +31,7 @@ import Language.ECMAScript3.Parser.State
import Language.ECMAScript3.Parser.Type
import Language.ECMAScript3.Syntax
import Language.ECMAScript3.Syntax.Annotations
-import Data.Default
+import Data.Default.Class
import Text.Parsec hiding (parse)
import Text.Parsec.Expr
import Control.Monad(liftM,liftM2)
@@ -37,6 +40,24 @@ import Numeric(readDec,readOct,readHex)
import Data.Char
import Control.Monad.Identity
import Data.Maybe (isJust, isNothing, fromMaybe)
+import Control.Monad.Error.Class
+
+{-# DEPRECATED ParsedStatement, ParsedExpression, StatementParser,
+ ExpressionParser
+ "These type aliases will be hidden in the next version" #-}
+
+{-# DEPRECATED parseSimpleExpr', parseBlockStmt, parseObjectLit
+ "These parsers will be hidden in the next version" #-}
+
+{-# DEPRECATED assignExpr, parseExpression "Use 'expression' instead" #-}
+
+{-# DEPRECATED parseStatement "Use 'statement' instead" #-}
+
+{-# DEPRECATED parseScript "Use 'program' instead" #-}
+
+{-# DEPRECATED parseScriptFromString, parseString "Use 'parseFromString' instead" #-}
+
+{-# DEPRECATED parseJavaScriptFromFile "Use 'parseFromFile' instead" #-}
-- We parameterize the parse tree over source-locations.
type ParsedStatement = Statement SourcePos
@@ -46,7 +67,6 @@ type ParsedExpression = Expression SourcePos
type StatementParser s = Parser s ParsedStatement
type ExpressionParser s = Parser s ParsedExpression
-
initialParserState :: ParserState
initialParserState = []
@@ -303,7 +323,7 @@ parseFunctionStmt = do
"function body in { ... }"
return (FunctionStmt pos name args body)
-parseStatement:: Stream s Identity Char => StatementParser s
+parseStatement :: Stream s Identity Char => StatementParser s
parseStatement = parseIfStmt <|> parseSwitchStmt <|> parseWhileStmt
<|> parseDoWhileStmt <|> parseContinueStmt <|> parseBreakStmt
<|> parseBlockStmt <|> parseEmptyStmt <|> parseForInStmt <|> parseForStmt
@@ -312,6 +332,10 @@ parseStatement = parseIfStmt <|> parseSwitchStmt <|> parseWhileStmt
-- labelled, expression and the error message always go last, in this order
<|> parseLabelledStmt <|> parseExpressionStmt <?> "statement"
+-- | The parser that parses a single ECMAScript statement
+statement :: Stream s Identity Char => Parser s (Statement SourcePos)
+statement = parseStatement
+
--}}}
--{{{ Expressions
@@ -473,7 +497,7 @@ parseObjectLit =
--{{{ Parsing numbers. From pg. 17-18 of ECMA-262.
hexLit :: Stream s Identity Char => Parser s (Bool, Double)
hexLit = do
- try (string "0x")
+ try (char '0' >> oneOf "xX")
digits <- many1 (oneOf "0123456789abcdefABCDEF")
[(hex,"")] <- return $ Numeric.readHex digits
return (True, hex)
@@ -735,6 +759,10 @@ assignExpr = do
parseExpression:: Stream s Identity Char => ExpressionParser s
parseExpression = assignExpr
+-- | A parser that parses ECMAScript expressions
+expression :: Stream s Identity Char => Parser s (Expression SourcePos)
+expression = assignExpr
+
parseListExpr :: Stream s Identity Char => ExpressionParser s
parseListExpr = assignExpr `sepBy1` comma >>= \exprs ->
case exprs of
@@ -745,8 +773,14 @@ parseScript:: Stream s Identity Char => Parser s (JavaScript SourcePos)
parseScript = do
whiteSpace
liftM2 Script getPosition (parseStatement `sepBy` whiteSpace)
+
+-- | A parser that parses an ECMAScript program.
+program :: Stream s Identity Char => Parser s (JavaScript SourcePos)
+program = parseScript
--- | Parse from a stream; same as 'Text.Parsec.parse'
+-- | Parse from a stream given a parser, same as 'Text.Parsec.parse'
+-- in Parsec. We can use this to parse expressions or statements alone,
+-- not just whole programs.
parse :: Stream s Identity Char
=> Parser s a -- ^ The parser to use
-> SourceName -- ^ Name of the source file
@@ -754,6 +788,25 @@ parse :: Stream s Identity Char
-> Either ParseError a
parse p = runParser p initialParserState
+-- | A convenience function that takes a 'String' and tries to parse
+-- it as an ECMAScript program:
+--
+-- > parseFromString = parse program ""
+parseFromString :: String -- ^ JavaScript source to parse
+ -> Either ParseError (JavaScript SourcePos)
+parseFromString = parse program ""
+
+-- | A convenience function that takes a filename and tries to parse
+-- the file contents an ECMAScript program, it fails with an error
+-- message if it can't.
+parseFromFile :: (Error e, MonadIO m, MonadError e m) => String -- ^ file name
+ -> m (JavaScript SourcePos)
+parseFromFile fname =
+ liftIO (readFile fname) >>= \source ->
+ case parse program fname source of
+ Left err -> throwError $ strMsg $ show err
+ Right js -> return js
+
-- | Read a JavaScript program from file an parse it into a list of
-- statements
parseJavaScriptFromFile :: MonadIO m => String -- ^ file name
diff --git a/src/Language/ECMAScript3/Parser/Type.hs b/src/Language/ECMAScript3/Parser/Type.hs
index df51eaa..b2958e6 100644
--- a/src/Language/ECMAScript3/Parser/Type.hs
+++ b/src/Language/ECMAScript3/Parser/Type.hs
@@ -4,4 +4,6 @@ import Language.ECMAScript3.Parser.State
import Text.Parsec
import Control.Monad.Identity
-type Parser s a = ParsecT s ParserState Identity a \ No newline at end of file
+-- | The parser type, parametrised by the stream type @s@ and the
+-- return value @a@
+type Parser s a = ParsecT s ParserState Identity a
diff --git a/src/Language/ECMAScript3/PrettyPrint.hs b/src/Language/ECMAScript3/PrettyPrint.hs
index 21470b5..22c3a7b 100644
--- a/src/Language/ECMAScript3/PrettyPrint.hs
+++ b/src/Language/ECMAScript3/PrettyPrint.hs
@@ -228,13 +228,22 @@ jsEscape (ch:chs) = sel ch ++ jsEscape chs where
sel '\\' = "\\\\"
sel x = [x]
-- We don't have to do anything about \X, \x and \u escape sequences.
-
+
+-- | Escapes a regular expression so that it can be parsed correctly afterwards
regexpEscape :: String -> String
-regexpEscape "" = ""
-regexpEscape "\\" = "\\\\"
-regexpEscape ('\\':c:rest) = '\\':c:(regexpEscape rest)
-regexpEscape ('/':rest) = '\\':'/':regexpEscape rest
-regexpEscape (c:rest) = c:regexpEscape rest
+regexpEscape = regexpEscapeChar True
+ where regexpEscapeChar :: Bool -- ^ First char?
+ -> String -> String
+ regexpEscapeChar first s =
+ case (s, first) of
+ ("", True) -> "(?:)"
+ ("", False)-> ""
+ -- see spec 7.8.5, RegularExpressionFirstChar
+ ("\\", _) -> "\\\\"
+ ('\\':c:rest, _) -> '\\':c:(regexpEscapeChar False rest)
+ ('/':rest, _) -> '\\':'/':regexpEscapeChar False rest
+ ('*':rest, True) -> ('\\':'*':regexpEscapeChar False rest)
+ (c:rest, _) -> c:regexpEscapeChar False rest
-- 11.1
ppPrimaryExpression :: Expression a -> Doc
diff --git a/src/Language/ECMAScript3/SourceDiff.hs b/src/Language/ECMAScript3/SourceDiff.hs
new file mode 100644
index 0000000..da2db6b
--- /dev/null
+++ b/src/Language/ECMAScript3/SourceDiff.hs
@@ -0,0 +1,24 @@
+-- | Simple textual diffing of JavaScript programs for inspecting test
+-- failures
+module Language.ECMAScript3.SourceDiff where
+
+import Data.Algorithm.Diff
+--import Data.Algorithm.DiffOutput
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.PrettyPrint
+import Data.List (intersperse)
+
+
+jsDiff :: JavaScript a -> JavaScript a -> String
+jsDiff js1 js2 =
+ -- let plines = lines . show . prettyPrint
+ -- in ppDiff $ getGroupedDiff (plines js1) (plines js2)
+ let plines = lines . show . prettyPrint
+ diff = getGroupedDiff (plines js1) (plines js2)
+ formatDiff :: Diff [String] -> String
+ formatDiff d = let (prefix, strs) = case d of
+ First ss -> ('-', ss)
+ Second ss -> ('+', ss)
+ Both ss _ -> (' ', ss)
+ in concat $ intersperse "\n" $ map (prefix:) strs
+ in concat $ intersperse "\n" $ map formatDiff diff
diff --git a/src/Language/ECMAScript3/Syntax.hs b/src/Language/ECMAScript3/Syntax.hs
index b5b2b13..d3f6f61 100644
--- a/src/Language/ECMAScript3/Syntax.hs
+++ b/src/Language/ECMAScript3/Syntax.hs
@@ -26,10 +26,11 @@ module Language.ECMAScript3.Syntax (JavaScript(..)
) where
import Text.Parsec.Pos(initialPos,SourcePos) -- used by data JavaScript
-import Data.Generics(Data,Typeable)
+import Data.Data (Data)
+import Data.Typeable (Typeable)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
-import Data.Default
+import Data.Default.Class
data JavaScript a
-- |A script in \<script\> ... \</script\> tags.
diff --git a/src/Language/ECMAScript3/Syntax/Arbitrary.hs b/src/Language/ECMAScript3/Syntax/Arbitrary.hs
index 0705ed6..cd587a3 100644
--- a/src/Language/ECMAScript3/Syntax/Arbitrary.hs
+++ b/src/Language/ECMAScript3/Syntax/Arbitrary.hs
@@ -110,6 +110,12 @@ rrarbitrary = recursive $ recursive arbitrary
atLeastOfSize :: Arbitrary a => Int -> Gen a -> Gen a
atLeastOfSize l gen = sized $ \s -> if s < l then resize l gen else gen
+listOfN :: Arbitrary a => Int -> Gen a -> Gen [a]
+listOfN l gen = sized $ \n ->
+ let l' = l `max` 0
+ in do k <- choose (l', l' `max` n)
+ vectorOf k gen
+
nonEmptyString :: Gen String
nonEmptyString = sized $ \s -> if s < 1 then stringOfLength 1 else stringOfLength s
@@ -144,7 +150,7 @@ instance Arbitrary a => Arbitrary (Expression a) where
(2, liftM4 InfixExpr arbitrary arbitrary rarbitrary rarbitrary),
(3, liftM4 CondExpr arbitrary rarbitrary rarbitrary rarbitrary),
(3, liftM4 AssignExpr arbitrary rarbitrary rarbitrary rarbitrary),
- (3, liftM2 ListExpr arbitrary (recursive (atLeastOfSize 2 arbitrary))),
+ (3, liftM2 ListExpr arbitrary (recursive (listOfN 2 arbitrary))),
(3, liftM3 CallExpr arbitrary rarbitrary rrarbitrary),
(1, liftM4 FuncExpr arbitrary arbitrary arbitrary rarbitrary)]
@@ -216,7 +222,7 @@ instance Arbitrary a => Arbitrary (Statement a) where
(1, liftM2 ThrowStmt arbitrary rarbitrary),
(1, liftM2 ReturnStmt arbitrary rarbitrary),
(2, liftM3 WithStmt arbitrary rarbitrary rarbitrary),
- (2, liftM2 VarDeclStmt arbitrary rrarbitrary),
+ (2, liftM2 VarDeclStmt arbitrary (listOf1 rrarbitrary)),
(1, liftM4 FunctionStmt arbitrary arbitrary arbitrary rarbitrary)]
where arbtry =
do (mCatch, mFinally) <- oneof [liftM2 (,) (return Nothing) (liftM Just rarbitrary),
@@ -330,7 +336,7 @@ isBreakContinueFixable stmt inLabeled inIter inSwitch =
else True
-- _ -> continue stmt inLabeled inIter inSwitch
where continue stmt inLabeled inIter inSwitch =
- and $ map (\s -> isBreakContinueFixable s inLabeled inIter inSwitch) (children stmt)
+ and $ map (\s -> isBreakContinueFixable s inLabeled inIter inSwitch) (children stmt)
-- | Removes duplicate labels from nested labeled statements in order
-- to impose restrictions on labeled statements as per ECMAScript 5
@@ -380,4 +386,4 @@ fixBreakContinueLabels (Script x stmts) =
isSwitchStmt :: Statement a -> Bool
isSwitchStmt (SwitchStmt _ _ _) = True
-isSwitchStmt _ = False \ No newline at end of file
+isSwitchStmt _ = False
diff --git a/src/Language/ECMAScript3/Syntax/QuasiQuote.hs b/src/Language/ECMAScript3/Syntax/QuasiQuote.hs
index 410f5b2..8e63216 100644
--- a/src/Language/ECMAScript3/Syntax/QuasiQuote.hs
+++ b/src/Language/ECMAScript3/Syntax/QuasiQuote.hs
@@ -23,13 +23,13 @@ js :: QuasiQuoter
js = QuasiQuoter {quoteExp = quoteJS}
quoteJSExpr :: String -> TH.ExpQ
-quoteJSExpr = quoteCommon parseExpression
+quoteJSExpr = quoteCommon expression
quoteJSStmt :: String -> TH.ExpQ
-quoteJSStmt = quoteCommon parseStatement
+quoteJSStmt = quoteCommon statement
quoteJS :: String -> TH.ExpQ
-quoteJS = quoteCommon parseScript
+quoteJS = quoteCommon program
quoteCommon :: Data a => Parser String a -> String -> TH.ExpQ
quoteCommon p s = do loc <- TH.location
diff --git a/src/PrettyTest.hs b/src/PrettyTest.hs
deleted file mode 100644
index 933ec70..0000000
--- a/src/PrettyTest.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-module Main where
-
-import Language.ECMAScript3.Parser
-import Language.ECMAScript3.PrettyPrint
-import Language.ECMAScript3.Syntax
-import Language.ECMAScript3.Syntax.Arbitrary()
-import Language.ECMAScript3.Syntax.Annotations
-import Test.QuickCheck
-import System.Exit
-
-main :: IO ()
-main =
- let qcArgs = Args {maxSuccess = 50
- ,maxDiscardRatio = 10
- ,maxSize = 10
- ,replay = Nothing
- ,chatty = True}
- in quickCheckWithResult qcArgs prettyParseEquivalence >>= \res ->
- case res of
- Success {} -> putStrLn "All tests passes"
- GaveUp {} -> putStrLn "Gave up"
- Failure {} -> putStrLn "Test failed" >> exitFailure
- NoExpectedFailure {} -> putStrLn "Unexpected failure" >> exitFailure
-
-prettyParseEquivalence :: JavaScript () -> Bool
-prettyParseEquivalence js =
- case parseScriptFromString "" $ show $ prettyPrint js of
- Left _ -> False
- Right parsed -> (reannotate (const ()) parsed) == js
diff --git a/src/UnitTest.hs b/src/UnitTest.hs
deleted file mode 100644
index bb10062..0000000
--- a/src/UnitTest.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Main where
-
-import Test.HUnit
-import System.Exit
-import System.Directory
-import qualified System.FilePath as FilePath
-import Language.ECMAScript3.Parser
-import Language.ECMAScript3.PrettyPrint
-import Language.ECMAScript3.Syntax
-
-testDir = "tests/parse-pretty"
-
-
--- | tests the parser with pre-defined test-cases
-parsePrettyTest filename = TestLabel filename $ TestCase $ do
- js <- parseJavaScriptFromFile filename
- let str = renderStatements js
- case parseScriptFromString "" str of
- Left err -> assertFailure (show err)
- Right (Script _ js') -> do
- let str' = renderStatements js'
- assertBool "pretty-printed code should re-parse" (str == str')
-
-main = do
- allFiles <- getDirectoryContents testDir
- let files = map (testDir `FilePath.combine`) $
- filter (\x -> FilePath.takeExtension x == ".js") allFiles
- let parsePretty = TestLabel "parser - printer composition"
- (TestList (map parsePrettyTest files))
- results <- runTestTT parsePretty
- if errors results > 0 || failures results > 0
- then exitFailure
- else putStrLn "All tests passed."
diff --git a/test/Test/Diff.hs b/test/Test/Diff.hs
new file mode 100644
index 0000000..bdc092f
--- /dev/null
+++ b/test/Test/Diff.hs
@@ -0,0 +1,58 @@
+module Test.Diff where
+
+import Test.HUnit hiding (Test)
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import System.Exit
+import System.Directory
+import qualified System.FilePath as FP
+import Language.ECMAScript3.Parser
+import Language.ECMAScript3.PrettyPrint
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.Syntax.Annotations
+import Language.ECMAScript3.SourceDiff
+import Control.Monad
+
+tests_diff :: Test
+tests_diff =
+ buildTest $
+ do allLefts <- getDirectoryContents leftDir
+ allRights <- getDirectoryContents rightDir
+ allDiffs <- getDirectoryContents expectsDir
+ let validLefts = getValidJS allLefts
+ let validRights = getValidJS allRights
+ let validDiffs = getValidDiffs allDiffs
+ return $ testGroup "Source Diff tests" $
+ map genTest $ filter ((`elem` (map FP.dropExtension validDiffs)) .
+ FP.dropExtension)
+ $ filter (`elem` validRights) validLefts
+ where getValidJS = filter $ \x -> FP.takeExtension x == ".js"
+ getValidDiffs = filter $ \x -> FP.takeExtension x == ".diff"
+
+leftDir = "test/diff/left"
+rightDir = "test/diff/right"
+expectsDir = "test/diff/expects"
+
+genTest :: FilePath -> Test
+genTest testFileName = testCase testFileName $
+ diffTest (leftDir `FP.combine` testFileName)
+ (rightDir `FP.combine` testFileName)
+ (expectsDir `FP.combine`
+ ((FP.dropExtension testFileName)
+ `FP.addExtension` "diff"))
+
+diffTest :: FilePath -> FilePath -> FilePath -> Assertion
+diffTest leftFile rightFile diffFile =
+ do left <- readFile leftFile
+ right <- readFile rightFile
+ expect<- readFile diffFile
+ let x = do ljs <- parseFromString left
+ rjs <- parseFromString right
+ return (removeAnnotations ljs, removeAnnotations rjs)
+ case x of
+ Left err -> assertFailure $ "Parsing error: " ++ (show err)
+ Right (ljs, rjs) ->
+ let diff = jsDiff ljs rjs
+ msg = "Failed to match diff output to an expected one. Expected:\n"
+ ++ expect ++ "\nSaw:\n" ++ diff
+ in unless (diff == expect) (assertFailure msg)
diff --git a/test/Test/Pretty.hs b/test/Test/Pretty.hs
new file mode 100644
index 0000000..2706f4c
--- /dev/null
+++ b/test/Test/Pretty.hs
@@ -0,0 +1,43 @@
+module Test.Pretty where
+
+import Test.Framework
+import Test.Framework.Providers.QuickCheck2
+import Language.ECMAScript3.Parser
+import Language.ECMAScript3.PrettyPrint
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.Syntax.Arbitrary()
+import Language.ECMAScript3.Syntax.Annotations
+--import System.Exit
+import Language.ECMAScript3.SourceDiff
+import Test.QuickCheck
+
+tests_pretty :: Test
+tests_pretty = testProperty "Parse is the inverse of pretty" prettyParseEquivalence
+
+-- main :: IO ()
+-- main =
+-- let qcArgs = Args {maxSuccess = 50
+-- ,maxDiscardRatio = 10
+-- ,maxSize = 10
+-- ,replay = Nothing
+-- ,chatty = False}
+-- in quickCheckWithResult qcArgs prettyParseEquivalence >>= \res ->
+-- case res of
+-- Success {} -> putStrLn "All tests passes"
+-- GaveUp {} -> putStrLn "Gave up"
+-- Failure {} -> putStrLn "Test failed" >> exitFailure
+-- NoExpectedFailure {} -> putStrLn "Unexpected failure" >> exitFailure
+
+prettyParseEquivalence :: JavaScript () -> Property
+prettyParseEquivalence orig =
+ let pp = show $ prettyPrint orig
+ in case parseFromString pp of
+ Left e ->
+ let err = "Can't parse pretty-printed code. The error was: " ++ (show e) ++
+ "\nThe pretty-printed code in question:\n" ++ pp
+ in whenFail (putStrLn err) False
+ Right parsed ->
+ let eq = (removeAnnotations parsed) == orig
+ msg ="The parse of the pretty-printed AST didn't match the original\n"
+ ++"Diff:\n" ++ jsDiff orig (reannotate (const ()) parsed)
+ in whenFail (putStrLn msg) eq
diff --git a/test/Test/Unit.hs b/test/Test/Unit.hs
new file mode 100644
index 0000000..94159fa
--- /dev/null
+++ b/test/Test/Unit.hs
@@ -0,0 +1,49 @@
+module Test.Unit where
+
+import Test.Framework
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+import System.Exit
+import System.Directory
+import qualified System.FilePath as FilePath
+import Language.ECMAScript3.Parser
+import Language.ECMAScript3.PrettyPrint
+import Language.ECMAScript3.Syntax
+import Language.ECMAScript3.Syntax.Annotations
+import Language.ECMAScript3.SourceDiff
+import Control.Monad
+
+
+tests_unit :: Test
+tests_unit =
+ buildTest $
+ do allFiles <- getDirectoryContents testDir
+ let validFiles = filter (\x -> FilePath.takeExtension x == ".js") allFiles
+ return $ testGroup "Parser Unit tests" $ map genTest validFiles
+
+
+genTest :: FilePath -> Test
+genTest file = testCase file $ parsePrettyTest (testDir `FilePath.combine` file)
+
+testDir = "test/parse-pretty"
+
+-- | tests the parser with pre-defined test-cases
+parsePrettyTest :: FilePath -> Assertion
+parsePrettyTest filename =
+ readFile filename >>= \src ->
+ case parseFromString src of
+ Left err -> assertFailure $ "Can't parse a test-case: " ++ filename
+ Right js -> let str = show $ prettyPrint js
+ in case parseFromString str of
+ Left err ->
+ let msg = "Can't parse pretty-printed code. The error was: "
+ ++ (show err)
+ ++ "\nThe pretty-printed code in question:\n" ++ str
+ in assertFailure msg
+ Right js' -> do
+ let str' = show $ prettyPrint js'
+ unless (str == str') $ do
+ let msg = "The parse of the pretty-printed AST didn't match the original\n"
+ ++ "Diff:\n" ++ jsDiff js js'
+ assertFailure msg
+
diff --git a/test/TestMain.hs b/test/TestMain.hs
new file mode 100644
index 0000000..66da04b
--- /dev/null
+++ b/test/TestMain.hs
@@ -0,0 +1,12 @@
+-- | main entry point for tests
+module Main where
+
+import Test.Framework
+import Test.Unit
+import Test.Pretty
+import Test.Diff
+
+-- entry point for the test-suite
+main = defaultMain tests
+
+tests = [tests_diff, tests_pretty, tests_unit]
diff --git a/test/diff/expects/t1.diff b/test/diff/expects/t1.diff
new file mode 100644
index 0000000..9dfd1c2
--- /dev/null
+++ b/test/diff/expects/t1.diff
@@ -0,0 +1,2 @@
+ x = 1;
+-y = 2; \ No newline at end of file
diff --git a/test/diff/left/t1.js b/test/diff/left/t1.js
new file mode 100644
index 0000000..4817ac6
--- /dev/null
+++ b/test/diff/left/t1.js
@@ -0,0 +1,2 @@
+x = 1;
+y = 2;
diff --git a/test/diff/right/t1.js b/test/diff/right/t1.js
new file mode 100644
index 0000000..198b8f8
--- /dev/null
+++ b/test/diff/right/t1.js
@@ -0,0 +1 @@
+x = 1;
diff --git a/tests/parse-pretty/add.js b/test/parse-pretty/add.js
index 3436956..3436956 100644
--- a/tests/parse-pretty/add.js
+++ b/test/parse-pretty/add.js
diff --git a/tests/parse-pretty/do-while.js b/test/parse-pretty/do-while.js
index 3963840..3963840 100644
--- a/tests/parse-pretty/do-while.js
+++ b/test/parse-pretty/do-while.js
diff --git a/tests/parse-pretty/flapjax-fxinternal-22dec2008.js b/test/parse-pretty/flapjax-fxinternal-22dec2008.js
index 43d1c6e..43d1c6e 100644
--- a/tests/parse-pretty/flapjax-fxinternal-22dec2008.js
+++ b/test/parse-pretty/flapjax-fxinternal-22dec2008.js
diff --git a/tests/parse-pretty/neg.js b/test/parse-pretty/neg.js
index be41614..be41614 100644
--- a/tests/parse-pretty/neg.js
+++ b/test/parse-pretty/neg.js
diff --git a/tests/parse-pretty/numbers.js b/test/parse-pretty/numbers.js
index b29b7be..b29b7be 100644
--- a/tests/parse-pretty/numbers.js
+++ b/test/parse-pretty/numbers.js
diff --git a/tests/parse-pretty/object-lit-1.js b/test/parse-pretty/object-lit-1.js
index 9a3c5eb..9a3c5eb 100644
--- a/tests/parse-pretty/object-lit-1.js
+++ b/test/parse-pretty/object-lit-1.js
diff --git a/tests/parse-pretty/object-lit-2.js b/test/parse-pretty/object-lit-2.js
index 24337ef..24337ef 100644
--- a/tests/parse-pretty/object-lit-2.js
+++ b/test/parse-pretty/object-lit-2.js
diff --git a/tests/parse-pretty/prefix-chain.js b/test/parse-pretty/prefix-chain.js
index 9ff2ec3..9ff2ec3 100644
--- a/tests/parse-pretty/prefix-chain.js
+++ b/test/parse-pretty/prefix-chain.js
diff --git a/tests/parse-pretty/strings.js b/test/parse-pretty/strings.js
index 2fa431d..2fa431d 100644
--- a/tests/parse-pretty/strings.js
+++ b/test/parse-pretty/strings.js