forked from GitHub/gf-core
update the testsuite for the parser to the latest API
This commit is contained in:
@@ -2,6 +2,7 @@ import PGF
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.CPUTime
|
import System.CPUTime
|
||||||
|
import System.Random
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Set as Set (fromList,toList)
|
import Data.Set as Set (fromList,toList)
|
||||||
|
|
||||||
@@ -9,14 +10,15 @@ start_cat = fromJust (readType "Phr")
|
|||||||
|
|
||||||
main = do
|
main = do
|
||||||
pgf <- readPGF "Lang.pgf"
|
pgf <- readPGF "Lang.pgf"
|
||||||
trees0 <- generateRandom pgf start_cat
|
g <- newStdGen
|
||||||
|
let trees0 = generateRandomDepth g pgf start_cat (Just 5)
|
||||||
let trees = Set.toList (Set.fromList (take 5000 trees0))
|
let trees = Set.toList (Set.fromList (take 5000 trees0))
|
||||||
hPutStrLn stderr ("Number of trees: "++show (length trees))
|
hPutStrLn stderr ("Number of trees: "++show (length trees))
|
||||||
mapM_ (\l -> doTestLang pgf l trees) (languages pgf)
|
mapM_ (\l -> doTestLang pgf l trees) (languages pgf)
|
||||||
|
|
||||||
doTestLang pgf l ts = do
|
doTestLang pgf l ts = do
|
||||||
hPutStrLn stderr (show l)
|
hPutStrLn stderr (show l)
|
||||||
ss <- foldM (doTest pgf l (fromJust (readType "Phr"))) [] ts
|
ss <- foldM (doTest pgf l start_cat) [] ts
|
||||||
mapM_ (hPutStrLn stderr . show) [(fromIntegral s / fromIntegral n)/1000000000 | (s,n) <- ss]
|
mapM_ (hPutStrLn stderr . show) [(fromIntegral s / fromIntegral n)/1000000000 | (s,n) <- ss]
|
||||||
putStrLn "Done."
|
putStrLn "Done."
|
||||||
|
|
||||||
@@ -34,7 +36,7 @@ doTest pgf lang cat ss t = do
|
|||||||
|
|
||||||
doParse st t1 ts [] = return (Just (st,reverse ts))
|
doParse st t1 ts [] = return (Just (st,reverse ts))
|
||||||
doParse st t1 ts (tk:tks) = do
|
doParse st t1 ts (tk:tks) = do
|
||||||
case nextState st tk of
|
case nextState st (simpleParseInput tk) of
|
||||||
Left _ -> return Nothing
|
Left _ -> return Nothing
|
||||||
Right st -> do t2 <- getCPUTime
|
Right st -> do t2 <- getCPUTime
|
||||||
doParse st t1 ((t2-t1):ts) tks
|
doParse st t1 ((t2-t1):ts) tks
|
||||||
|
|||||||
Reference in New Issue
Block a user