Improve mkTreebank script. Add 100-tree Phrasebook treebank. Improve output in testsuite.

2021-03-03 11:01:31 +01:00
parent 997d7c1694
commit a8e3dc8855
6 changed files with 2650 additions and 24 deletions
--- a/gf.cabal
+++ b/gf.cabal
@@ -521,6 +521,7 @@ test-suite lpgf
  else
    other-modules: GF.System.NoSignal
  build-depends:
+    ansi-terminal,
    array,
    base>=4.6 && <5,
    bytestring,
--- a/testsuite/lpgf/mkTreebank.sh
+++ b/testsuite/lpgf/mkTreebank.sh
@@ -7,13 +7,20 @@ fi
 TREES=$1
 ABSNAME="${1%.*}"
 TREEBANK="$ABSNAME.treebank"
+SCRIPT="tmp.gfs"

 # echo "read_file -file=$TREES -lines -tree | linearize -treebank | write_file -file=$TREEBANK" | gf --run $ABSNAME*.gf

-: > $TREEBANK
+echo "Writing $SCRIPT"
+: > $SCRIPT
 while read tree; do
-  echo "linearize -treebank -bind $tree | write_file -file=$TREEBANK -append" | gf --run $ABSNAME*.gf | awk NF
-  echo "" >> $TREEBANK
+  echo "linearize -treebank -bind $tree | write_file -file=$TREEBANK -append"  >> "$SCRIPT"
+  echo "put_string \"\" | write_file -file=$TREEBANK -append"  >> "$SCRIPT"
 done < $TREES

-echo "Wrote $TREEBANK"
+echo "Writing $TREEBANK"
+: > $TREEBANK
+gf --run $ABSNAME*.gf < "$SCRIPT" | awk NF
+
+echo "Removing $SCRIPT"
+rm "$SCRIPT"
--- a/testsuite/lpgf/phrasebook/Phrasebook-100.trees
+++ b/testsuite/lpgf/phrasebook/Phrasebook-100.trees
@@ -0,0 +1,100 @@
+PSentence (SHaveNoMass (Children (Children WeFemale)) Chicken)
+PImperativeFamPos VSwim
+PGreetingFemale GHowAreYou
+PImperativeFamNeg VWrite
+PImperativeFamNeg VStop
+PImperativePlurNeg (V2Eat (OneObj (ObjMass Salt)))
+PQuestion (QProp (Is (ThisMass Chicken) (Too Fresh)))
+PImperativePolNeg (V2Eat (OneObj (ObjIndef Apple)))
+PImperativePlurNeg VWait
+PImperativeFamNeg VEat
+PSentence (SPropNot (PropOpen (APlace AmusementPark)))
+PImperativePolPos (V2Eat (OneObj (ObjMass Meat)))
+PImperativePolPos VWait
+PImperativeFamNeg VRun
+PImperativePolPos VStop
+PImperativePlurNeg VSleep
+PSentence (SHaveNo (Son (Daughter YouPlurPolMale)) (SuchKind (Very Fresh) Pizza))
+PImperativePolNeg VSwim
+PImperativePolNeg VWait
+PGreetingMale GGoodMorning
+PGreetingFemale GSorryPol
+PGreetingFemale GExcuse
+PImperativePlurPos VWalk
+PImperativePlurNeg VWalk
+PSentence (SHaveNo YouFamMale Pizza)
+PQuestion (HowFarFromBy (SuperlPlace TheMostExpensive Pharmacy) (SuperlPlace TheMostPopular Zoo) ByFoot)
+PImperativePolPos VWait
+PGreetingMale PNo
+PImperativePolNeg (V2Eat (OneObj (ObjIndef Pizza)))
+PImperativePlurPos (V2Eat (OneObj (ObjIndef Pizza)))
+PImperativeFamPos VDrink
+PGreetingMale GSeeYouSoon
+PImperativePolPos (V2Eat (OneObj (ObjPlural Apple)))
+PGreetingFemale PNo
+PImperativeFamNeg VRead
+PImperativeFamPos (V2Eat (OneObj (ObjPlural Pizza)))
+PImperativeFamPos VEat
+PImperativePlurPos VRead
+PSentence (SPropNot (PropClosedDay (SuperlPlace TheBest Station) Wednesday))
+PImperativePolPos (V2Eat (OneObj (ObjMass Meat)))
+PImperativeFamPos VPlay
+PGreetingMale GHappyBirthday
+PGreetingMale GPleaseGive
+PImperativeFamPos VStop
+PImperativeFamPos VRead
+PSentence (SPropNot (PropClosedDay (ThePlace Hotel) Thursday))
+PGreetingFemale PYes
+PImperativeFamNeg VWalk
+PGreetingMale GHello
+PImperativeFamNeg VSit
+PImperativeFamNeg VWrite
+PSentence (SHaveNoMass (Daughter YouPlurPolFemale) (SuchMassKind (PropQuality Boring) Salt))
+PImperativePlurNeg (V2Eat (OneObj (ObjMass Chicken)))
+PGreetingFemale GThanks
+PGreetingMale (PSeeYouPlaceDate (APlace Bank) Today)
+PImperativePlurPos VWalk
+PImperativeFamPos VWrite
+PImperativePolNeg VWait
+PQuestion (QWhereDoVerbPhrase (Husband YouPolMale) VEat)
+PImperativePlurNeg VStop
+PImperativeFamNeg VRun
+PImperativePolNeg VWrite
+PGreetingFemale PYesToNo
+PQuestion (HowFarBy (SuperlPlace TheWorst Church) ByFoot)
+PImperativeFamNeg VWalk
+PGreetingFemale GSorryPol
+PImperativePlurNeg VSit
+PImperativeFamNeg VWait
+PQuestion (HowFarBy (APlace Center) ByFoot)
+PImperativeFamPos VEat
+PImperativePlurPos VEat
+PGreetingMale GPleaseGive
+PImperativePlurPos VWrite
+PImperativeFamNeg VWait
+PImperativeFamPos VRun
+PQuestion (HowFar (APlace Zoo))
+PImperativeFamNeg (V2Wait (PersonName NameNN))
+PGreetingFemale GExcuse
+PImperativePlurNeg VSit
+PSentence (SHaveNo YouPolFemale (SuchKind (Too Cold) Apple))
+PGreetingFemale GGoodbye
+PImperativeFamPos VWait
+PImperativePolNeg VSit
+PGreetingMale GExcusePol
+PQuestion (WherePerson (Wife TheyMale))
+PImperativeFamPos VEat
+PImperativePlurNeg (V2Drink (OneObj (ObjPlural Apple)))
+PImperativeFamNeg (V2Eat (OneObj (ObjIndef Apple)))
+PImperativeFamPos VStop
+PImperativePlurNeg VStop
+PGreetingMale GGoodNight
+PGreetingFemale GWhatTime
+PQuestion (QWhereDoVerbPhrase YouPlurFamMale (V2Wait (Wife YouPlurPolMale)))
+PGreetingMale GNiceToMeetYou
+PGreetingFemale PYesToNo
+PImperativePlurPos VDrink
+PImperativeFamNeg VEat
+PImperativeFamPos VRead
+PSentence (SHave YouPlurPolFemale (OneObj (ObjIndef Pizza)))
+PSentence (SPropNot (PropOpenDay (SuperlPlace TheCheapest Supermarket) Thursday))
--- a/testsuite/lpgf/phrasebook/Phrasebook.treebank
+++ b/testsuite/lpgf/phrasebook/Phrasebook.treebank
--- a/testsuite/lpgf/phrasebook/Phrasebook.trees
+++ b/testsuite/lpgf/phrasebook/Phrasebook.trees
@@ -1 +1,100 @@
-PQuestion (HowFarFrom (APlace (CitRestaurant Indian)) (ThePlace Bank))
+PSentence (SHaveNoMass (Children (Children WeFemale)) Chicken)
+PImperativeFamPos VSwim
+PGreetingFemale GHowAreYou
+PImperativeFamNeg VWrite
+PImperativeFamNeg VStop
+PImperativePlurNeg (V2Eat (OneObj (ObjMass Salt)))
+PQuestion (QProp (Is (ThisMass Chicken) (Too Fresh)))
+PImperativePolNeg (V2Eat (OneObj (ObjIndef Apple)))
+PImperativePlurNeg VWait
+PImperativeFamNeg VEat
+PSentence (SPropNot (PropOpen (APlace AmusementPark)))
+PImperativePolPos (V2Eat (OneObj (ObjMass Meat)))
+PImperativePolPos VWait
+PImperativeFamNeg VRun
+PImperativePolPos VStop
+PImperativePlurNeg VSleep
+PSentence (SHaveNo (Son (Daughter YouPlurPolMale)) (SuchKind (Very Fresh) Pizza))
+PImperativePolNeg VSwim
+PImperativePolNeg VWait
+PGreetingMale GGoodMorning
+PGreetingFemale GSorryPol
+PGreetingFemale GExcuse
+PImperativePlurPos VWalk
+PImperativePlurNeg VWalk
+PSentence (SHaveNo YouFamMale Pizza)
+PQuestion (HowFarFromBy (SuperlPlace TheMostExpensive Pharmacy) (SuperlPlace TheMostPopular Zoo) ByFoot)
+PImperativePolPos VWait
+PGreetingMale PNo
+PImperativePolNeg (V2Eat (OneObj (ObjIndef Pizza)))
+PImperativePlurPos (V2Eat (OneObj (ObjIndef Pizza)))
+PImperativeFamPos VDrink
+PGreetingMale GSeeYouSoon
+PImperativePolPos (V2Eat (OneObj (ObjPlural Apple)))
+PGreetingFemale PNo
+PImperativeFamNeg VRead
+PImperativeFamPos (V2Eat (OneObj (ObjPlural Pizza)))
+PImperativeFamPos VEat
+PImperativePlurPos VRead
+PSentence (SPropNot (PropClosedDay (SuperlPlace TheBest Station) Wednesday))
+PImperativePolPos (V2Eat (OneObj (ObjMass Meat)))
+PImperativeFamPos VPlay
+PGreetingMale GHappyBirthday
+PGreetingMale GPleaseGive
+PImperativeFamPos VStop
+PImperativeFamPos VRead
+PSentence (SPropNot (PropClosedDay (ThePlace Hotel) Thursday))
+PGreetingFemale PYes
+PImperativeFamNeg VWalk
+PGreetingMale GHello
+PImperativeFamNeg VSit
+PImperativeFamNeg VWrite
+PSentence (SHaveNoMass (Daughter YouPlurPolFemale) (SuchMassKind (PropQuality Boring) Salt))
+PImperativePlurNeg (V2Eat (OneObj (ObjMass Chicken)))
+PGreetingFemale GThanks
+PGreetingMale (PSeeYouPlaceDate (APlace Bank) Today)
+PImperativePlurPos VWalk
+PImperativeFamPos VWrite
+PImperativePolNeg VWait
+PQuestion (QWhereDoVerbPhrase (Husband YouPolMale) VEat)
+PImperativePlurNeg VStop
+PImperativeFamNeg VRun
+PImperativePolNeg VWrite
+PGreetingFemale PYesToNo
+PQuestion (HowFarBy (SuperlPlace TheWorst Church) ByFoot)
+PImperativeFamNeg VWalk
+PGreetingFemale GSorryPol
+PImperativePlurNeg VSit
+PImperativeFamNeg VWait
+PQuestion (HowFarBy (APlace Center) ByFoot)
+PImperativeFamPos VEat
+PImperativePlurPos VEat
+PGreetingMale GPleaseGive
+PImperativePlurPos VWrite
+PImperativeFamNeg VWait
+PImperativeFamPos VRun
+PQuestion (HowFar (APlace Zoo))
+PImperativeFamNeg (V2Wait (PersonName NameNN))
+PGreetingFemale GExcuse
+PImperativePlurNeg VSit
+PSentence (SHaveNo YouPolFemale (SuchKind (Too Cold) Apple))
+PGreetingFemale GGoodbye
+PImperativeFamPos VWait
+PImperativePolNeg VSit
+PGreetingMale GExcusePol
+PQuestion (WherePerson (Wife TheyMale))
+PImperativeFamPos VEat
+PImperativePlurNeg (V2Drink (OneObj (ObjPlural Apple)))
+PImperativeFamNeg (V2Eat (OneObj (ObjIndef Apple)))
+PImperativeFamPos VStop
+PImperativePlurNeg VStop
+PGreetingMale GGoodNight
+PGreetingFemale GWhatTime
+PQuestion (QWhereDoVerbPhrase YouPlurFamMale (V2Wait (Wife YouPlurPolMale)))
+PGreetingMale GNiceToMeetYou
+PGreetingFemale PYesToNo
+PImperativePlurPos VDrink
+PImperativeFamNeg VEat
+PImperativeFamPos VRead
+PSentence (SHave YouPlurPolFemale (OneObj (ObjIndef Pizza)))
+PSentence (SPropNot (PropOpenDay (SuperlPlace TheCheapest Supermarket) Thursday))
--- a/testsuite/lpgf/test.hs
+++ b/testsuite/lpgf/test.hs
@@ -5,10 +5,12 @@ import PGF (showLanguage, readExpr)
 import GF (compileToLPGF, writeLPGF)
 import GF.Support (noOptions)

-import Control.Monad (forM_)
+import Control.Monad (forM, when)
 import qualified Data.List as L
 import qualified Data.Map as Map
+import System.Console.ANSI
 import System.Environment (getArgs)
+import System.Exit (exitFailure)
 import System.Directory (listDirectory)
 import System.FilePath ((</>), (<.>), takeDirectory, takeBaseName, takeExtension, dropExtension)
 import Text.Printf (printf)
@@ -61,29 +63,54 @@ doGrammar' path gname cncs = do

  -- Read treebank
  gs <- groups . lines <$> readFile (dir </> path </> gname <.> "treebank")
-  forM_ gs $ \grp -> do
+  results <- forM gs $ \grp -> do
    let ast = drop 2 $ dropWhile (/=':') $ head grp
-    printf "%s: %s\n" gname ast
+    printf "- %s: %s\n" gname ast
    let
      Just tree = readExpr ast
-      -- Do some linearization
+      -- Linearization into all languages
      outs =
        [ printf "%s: %s" (showLanguage lang) (linearizeConcrete concr tree)
        | (lang,concr) <- Map.toList (concretes lpgf)
        ]
-    mapM_ putStrLn outs

    -- filter out missing langs from treebank
    let golds = [ g | o <- outs, g <- tail grp, takeWhile (/=':') o == takeWhile (/=':') g  ]
-    if outs == golds
-    then putStrLn "✅\n"
-    else do
-      putStrLn "❌ expected:"
-      mapM_ putStrLn golds
-      putStrLn ""
-      error "Test failed"
+
+    rs <- forM (zip outs golds) $ \(out,gold) ->
+      if out == gold
+      then do
+        printPass out
+        return True
+      else do
+        printFail out gold
+        return False
+    putStrLn ""
+    return rs
+
+  let trees = length results
+  let langs = length (head results)
+  let total = length (concat results)
+  let (ts,fs) = L.partition id (concat results)
+  let passed = length ts
+  let failed = length fs
+  printf "Passed %d | Failed %d | Total %d lins (%d trees, %d languages)\n" passed failed total trees langs
+  when (failed > 0) exitFailure

 -- | Group list of lines by blank lines
 groups :: [String] -> [[String]]
 groups [] = []
 groups ss = let (a,b) = break (=="") ss in a : groups (drop 1 b)
+
+printPass s = do
+  setSGR [SetColor Foreground Vivid Green]
+  printf "✓"
+  setSGR [Reset]
+  printf " %s\n" s
+
+printFail s t = do
+  setSGR [SetColor Foreground Dull Red]
+  printf "✗ %s\n" s
+  setSGR [SetColor Foreground Dull Yellow]
+  printf "→ %s\n" t
+  setSGR [Reset]