Merge pull request #114 from 1Regina/fix-tests

Fix tests

.github/workflows/build-all-versions.yml

@@ -90,6 +90,6 @@ jobs:
         stack build --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml
         # stack build --system-ghc --test --bench --no-run-tests --no-run-benchmarks
 
-    # - name: Test
+    - name: Test
-    #   run: |
+      run: |
-    #     stack test --system-ghc
+        stack test --system-ghc --stack-yaml stack-ghc${{ matrix.ghc }}.yaml

.gitignore

@@ -53,6 +53,10 @@ DATA_DIR
 
 stack*.yaml.lock
 
+# Output files for test suite
+*.out
+gf-tests.html
+
 # Generated documentation (not exhaustive)
 demos/index-numbers.html
 demos/resourcegrammars.html

gf.cabal

@@ -353,4 +353,5 @@ test-suite gf-tests
   main-is:        run.hs
   hs-source-dirs: testsuite
   build-depends:  base>=4.3 && <5, Cabal>=1.8, directory, filepath, process
+  build-tool-depends: gf:gf
   default-language:    Haskell2010

src/compiler/GF/Command/Commands.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
 module GF.Command.Commands (
   PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
   options,flags,
@@ -741,7 +741,7 @@ pgfCommands = Map.fromList [
                                      Nothing   -> do putStrLn ("unknown category of function identifier "++show id)
                                                      return void
          [e]         -> case inferExpr pgf e of
-                          Left tcErr   -> error $ render (ppTcError tcErr)
+                          Left tcErr   -> errorWithoutStackTrace $ render (ppTcError tcErr)
                           Right (e,ty) -> do putStrLn ("Expression:  "++showExpr [] e)
                                              putStrLn ("Type:        "++showType [] ty)
                                              putStrLn ("Probability: "++show (probTree pgf e))
@@ -1019,3 +1019,7 @@ stanzas = map unlines . chop . lines where
   chop ls = case break (=="") ls of
     (ls1,[])  -> [ls1]
     (ls1,_:ls2) -> ls1 : chop ls2
+
+#if !(MIN_VERSION_base(4,9,0))
+errorWithoutStackTrace = error
+#endif

stack-ghc7.10.3.yaml

@@ -4,6 +4,8 @@ extra-deps:
 - happy-1.19.9
 - alex-3.2.4
 - transformers-compat-0.6.5
+- directory-1.2.3.0
+- process-1.2.3.0@sha256:ee08707f1c806ad4a628c5997d8eb6e66d2ae924283548277d85a66341d57322,1806
 
 allow-newer: true
 

testsuite/compiler/check/lincat-types/Predef.gf

@@ -0,0 +1,48 @@
+--1 Predefined functions for concrete syntax
+
+-- The definitions of these constants are hard-coded in GF, and defined
+-- in Predef.hs (gf-core/src/compiler/GF/Compile/Compute/Predef.hs).
+-- Applying them to run-time variables leads to compiler errors that are
+-- often only detected at the code generation time.
+
+resource Predef = {
+
+-- This type of booleans is for internal use only.
+
+  param PBool = PTrue | PFalse ;
+
+  oper Error : Type = variants {} ;          -- the empty type
+  oper Float : Type = variants {} ;          -- the type of floats
+  oper Int   : Type = variants {} ;          -- the type of integers
+  oper Ints  : Int -> PType = variants {} ;  -- the type of integers from 0 to n
+
+  oper error  : Str        -> Error    = variants {} ; -- forms error message
+  oper length : Tok ->        Int      = variants {} ; -- length of string
+  oper drop   : Int -> Tok -> Tok      = variants {} ; -- drop prefix of length
+  oper take   : Int -> Tok -> Tok      = variants {} ; -- take prefix of length
+  oper tk     : Int -> Tok -> Tok      = variants {} ; -- drop suffix of length
+  oper dp     : Int -> Tok -> Tok      = variants {} ; -- take suffix of length
+  oper eqInt  : Int -> Int -> PBool    = variants {} ; -- test if equal integers
+  oper lessInt: Int -> Int -> PBool    = variants {} ; -- test order of integers
+  oper plus   : Int -> Int -> Int      = variants {} ; -- add integers
+  oper eqStr  : Tok -> Tok -> PBool    = variants {} ; -- test if equal strings
+  oper occur  : Tok -> Tok -> PBool    = variants {} ; -- test if occurs as substring
+  oper occurs : Tok -> Tok -> PBool    = variants {} ; -- test if any char occurs
+  oper isUpper : Tok       -> PBool    = variants {} ; -- test if all chars are upper-case
+  oper toUpper : Tok       -> Tok      = variants {} ; -- map all chars to upper case
+  oper toLower : Tok       -> Tok      = variants {} ; -- map all chars to lower case
+  oper show   : (P : Type) -> P -> Tok = variants {} ; -- convert param to string
+  oper read   : (P : Type) -> Tok -> P = variants {} ; -- convert string to param
+  oper eqVal  : (P : Type) -> P -> P -> PBool = variants {} ; -- test if equal values
+  oper toStr  : (L : Type) -> L -> Str = variants {} ; -- find the "first" string
+  oper mapStr : (L : Type) -> (Str -> Str) -> L -> L = variants {} ; 
+               -- map all strings in a data structure; experimental ---
+
+  oper nonExist : Str = variants {} ;    -- a placeholder for non-existant morphological forms
+  oper BIND : Str = variants {} ;        -- a token for gluing
+  oper SOFT_BIND : Str = variants {} ;   -- a token for soft gluing
+  oper SOFT_SPACE : Str = variants {} ;  -- a token for soft space
+  oper CAPIT : Str = variants {} ;       -- a token for capitalization
+  oper ALL_CAPIT : Str = variants {} ;   -- a token for capitalization of abreviations
+
+} ;

testsuite/compiler/check/lincat-types/test.gfs.gold

@@ -1,7 +1,9 @@
 
 
+testsuite/compiler/check/lincat-types/TestCnc.gf:
    testsuite/compiler/check/lincat-types/TestCnc.gf:3:
      Happened in linearization type of S
        type of PTrue
       expected: Type
-   inferred: PBool
+      inferred: Predef.PBool
+      

testsuite/compiler/check/lins/lins.gfs.gold

@@ -1,6 +1,3 @@
-checking module linsCnc
-   Warning: no linearization type for C, inserting default {s : Str}
-   Warning: no linearization of test
 abstract lins {
   cat C Nat ;
   cat Float ;
@@ -12,16 +9,23 @@ abstract lins {
 }
 concrete linsCnc {
   productions
-    C1 -> F2[]
+    C1 -> F4[]
   lindefs
-    C0 -> F0
+    C0 -> F0[CVar]
-    C1 -> F1
+    C1 -> F2[CVar]
+  linrefs
+    CVar -> F1[C0]
+    CVar -> F3[C1]
   lin
-    F0 := (S0) [lindef C]
+    F0 := (S2) ['lindef C']
-    F1 := () [lindef Nat]
+    F1 := (S1) ['lindef C']
-    F2 := () [zero]
+    F2 := () ['lindef Nat']
+    F3 := (S0) ['lindef Nat']
+    F4 := () [zero]
   sequences
-    S0 := {0,0}
+    S0 :=
+    S1 := <0,0>
+    S2 := {0,0}
   categories
     C := range  [C0 .. C0]
          labels ["s"]
@@ -33,7 +37,5 @@ concrete linsCnc {
            labels []
     String := range  [CString .. CString]
               labels ["s"]
-    __gfVar := range  [CVar .. CVar]
-               labels [""]
   printnames
 }

testsuite/compiler/check/oper-definition/test.gfs.gold

@@ -1,5 +1,6 @@
 
 
+testsuite/compiler/check/oper-definition/Res.gf:
    testsuite/compiler/check/oper-definition/Res.gf:3:
      Happened in operation my_oper
       No definition given to the operation

testsuite/compiler/check/strMatch/Prelude.gf

@@ -0,0 +1,161 @@
+--1 The GF Prelude
+
+-- This file defines some prelude facilities usable in all grammars.
+
+resource Prelude = Predef[nonExist, BIND, SOFT_BIND, SOFT_SPACE, CAPIT, ALL_CAPIT] ** open (Predef=Predef) in {
+
+oper
+
+--2 Strings, records, and tables
+
+  SS  : Type = {s : Str} ;
+  ss  : Str -> SS = \s -> {s = s} ;
+  ss2 : (_,_ : Str) -> SS = \x,y -> ss (x ++ y) ;
+  ss3 : (_,_ ,_: Str) -> SS = \x,y,z -> ss (x ++ y ++ z) ;
+
+  cc2 : (_,_ : SS) -> SS = \x,y -> ss (x.s ++ y.s) ;
+  cc3 : (_,_,_ : SS) -> SS = \x,y,z -> ss (x.s ++ y.s ++ z.s) ;
+
+  SS1 : PType -> Type = \P -> {s : P => Str} ;
+  ss1 : (A : PType) -> Str -> SS1 A = \A,s -> {s = table {_ => s}} ;
+
+  SP1 : Type -> Type = \P -> {s : Str ; p : P} ;
+  sp1 : (A : Type) -> Str -> A -> SP1 A = \_,s,a -> {s = s ; p = a} ;
+
+  constTable : (A : PType) -> (B : Type) -> B -> A => B = \u,v,b -> \\_ => b ;
+  constStr   : (A : PType) -> Str -> A => Str = \A -> constTable A Str ;
+
+-- Discontinuous constituents.
+
+  SD2 : Type = {s1,s2 : Str} ;
+  sd2 : (_,_ : Str) -> SD2 = \x,y -> {s1 = x ; s2 = y} ;
+
+
+--2 Optional elements
+
+-- Optional string with preference on the string vs. empty.
+ 
+  optStr : Str -> Str = \s -> variants {s ; []} ;
+  strOpt : Str -> Str = \s -> variants {[] ; s} ;
+
+-- Free order between two strings.
+
+  bothWays : Str -> Str -> Str = \x,y -> variants {x ++ y ; y ++ x} ;
+
+-- Parametric order between two strings.
+
+  preOrPost : Bool -> Str -> Str -> Str = \pr,x,y -> 
+    if_then_Str pr (x ++ y) (y ++ x) ;
+
+--2 Infixes. prefixes, and postfixes
+
+-- Fixes with precedences are defined in [Precedence Precedence.html].
+
+  infixSS   : Str  -> SS -> SS -> SS = \f,x,y -> ss (x.s ++ f ++ y.s) ;
+  prefixSS  : Str        -> SS -> SS = \f,x   -> ss (f ++ x.s) ;
+  postfixSS : Str        -> SS -> SS = \f,x   -> ss (x.s ++ f) ;
+  embedSS   : Str -> Str -> SS -> SS = \f,g,x -> ss (f ++ x.s ++ g) ;
+
+
+--2 Booleans
+
+ param Bool = False | True ;
+
+oper
+  if_then_else : (A : Type) -> Bool -> A -> A -> A = \_,c,d,e -> 
+    case c of {
+      True => d ;  ---- should not need to qualify
+      False => e
+     } ;
+
+  andB : (_,_ : Bool) -> Bool = \a,b -> if_then_else Bool a b False ;
+  orB  : (_,_ : Bool) -> Bool = \a,b -> if_then_else Bool a True b ;
+  notB : Bool         -> Bool = \a   -> if_then_else Bool a False True ;
+
+  if_then_Str : Bool -> Str -> Str -> Str = if_then_else Str ;
+
+  onlyIf : Bool -> Str -> Str = \b,s -> case b of {
+    True => s ;
+    _ => nonExist
+    } ;
+
+-- Interface to internal booleans
+
+  pbool2bool : Predef.PBool -> Bool = \b -> case b of {
+    Predef.PFalse => False ; Predef.PTrue => True
+    } ;
+
+  init : Tok -> Tok = Predef.tk 1 ;
+  last : Tok -> Tok = Predef.dp 1 ;
+
+--2 High-level acces to Predef operations
+
+  isNil : Tok -> Bool = \b -> pbool2bool (Predef.eqStr [] b) ;
+
+  ifTok : (A : Type) -> Tok -> Tok -> A -> A -> A = \A,t,u,a,b -> 
+    case Predef.eqStr t u of {Predef.PTrue => a ; Predef.PFalse => b} ;
+
+--2 Lexer-related operations
+
+-- Bind together two tokens in some lexers, either obligatorily or optionally
+
+  oper 
+    glue : Str -> Str -> Str = \x,y -> x ++ BIND ++ y ;
+    glueOpt : Str -> Str -> Str = \x,y -> variants {glue x y ; x ++ y} ;
+    noglueOpt : Str -> Str -> Str = \x,y -> variants {x ++ y ; glue x y} ;
+
+-- Force capitalization of next word in some unlexers
+
+    capitalize : Str -> Str = \s -> CAPIT ++ s ;
+
+-- These should be hidden, and never changed since they are hardcoded in (un)lexers
+
+    PARA : Str = "&-" ;
+
+-- Embed between commas, where the latter one disappears in front of other punctuation
+
+    embedInCommas : Str -> Str = \s -> bindComma ++ s ++ endComma ;
+    endComma : Str = pre {"," | "." => []; "" => bindComma ; _ => []} ;
+
+    bindComma : Str = SOFT_BIND ++ "," ;
+    optComma : Str = bindComma | [] ;
+    optCommaSS : SS -> SS = \s -> ss (s.s ++ optComma) ;
+
+--2 Miscellaneous
+
+-- Identity function
+
+  id : (A : Type) -> A -> A = \_,a -> a ;
+
+-- Parentheses
+
+  paren : Str -> Str = \s -> "(" ++ s ++ ")" ;
+  parenss : SS -> SS = \s -> ss (paren s.s) ;
+
+-- Zero, one, two, or more (elements in a list etc)
+
+param
+  ENumber = E0 | E1 | E2 | Emore ;
+
+oper
+  eNext : ENumber -> ENumber = \e -> case e of {
+    E0 => E1 ; E1 => E2 ; _ => Emore} ;
+
+-- convert initial to upper/lower
+
+  toUpperFirst : Str -> Str = \s -> case s of {
+    x@? + xs => Predef.toUpper x + xs ;
+    _ => s
+    } ;
+
+  toLowerFirst : Str -> Str = \s -> case s of {
+    x@? + xs => Predef.toLower x + xs ;
+    _ => s
+    } ;
+
+-- handling errors caused by temporarily missing definitions
+
+  notYet : Str -> Predef.Error = \s ->
+    Predef.error ("NOT YET IMPLEMENTED:" ++ s) ;
+
+}

testsuite/compiler/check/strMatch/strMatch.gfs.gold

@@ -0,0 +1 @@
+

testsuite/compiler/typecheck/abstract/LetInDefAbs.gfs.gold

@@ -0,0 +1,15 @@
+fun f : Int -> Int ;
+def f n = ? ;
+000 CHECK_ARGS  1
+    ALLOC       2
+    PUT_CLOSURE 001
+    SET_PAD
+    TUCK        hp(0) 1
+    EVAL        f tail(0)
+001 ALLOC       2
+    PUT_LIT     0
+    PUSH_FRAME
+    PUSH        hp(0)
+    EVAL        f update
+Probability: 1.0
+

testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold

@@ -1 +1,3 @@
-fun f : (Int -> Int) -> Int -> Int
+fun f : (Int -> Int) -> Int -> Int ;
+Probability: 1.0
+

testsuite/compiler/typecheck/abstract/LitAbs.gf

@@ -5,7 +5,7 @@ cat CStr String ;
     CFloat Float ;
 
 data empty : CStr "" ;
-     null  : CStr [] ;
+    -- null  : CStr [] ; -- Commented out by IL 06/2021: causes parse error
      other : CStr "other" ;
 
 data zero : CInt 0 ;

testsuite/compiler/typecheck/abstract/LitAbs.gfs

@@ -1,5 +1,4 @@
 i -src testsuite/compiler/typecheck/abstract/LitAbs.gf
-ai null
 ai empty
 ai other
 ai zero

testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold

@@ -1,5 +1,12 @@
-data null : CStr ""
+data empty : CStr "" ;
-
+Probability: 0.5
-data empty : CStr ""
+
-
+data other : CStr "other" ;
-data other : CStr "other"
+Probability: 0.5
+
+data zero : CInt 0 ;
+Probability: 1.0
+
+data pi : CFloat 3.14 ;
+Probability: 1.0
+

testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs

@@ -1,2 +1,5 @@
 i -src testsuite/compiler/typecheck/abstract/PolyTypes.gf
+ai f
+
 i -src testsuite/compiler/typecheck/abstract/RecTypes.gf
+ai f

testsuite/compiler/typecheck/abstract/test_A.gfs.gold

@@ -1,5 +1,6 @@
 
 
+testsuite/compiler/typecheck/abstract/A.gf:
    testsuite/compiler/typecheck/abstract/A.gf:4:
      Happened in the category B
       Prod expected for function A instead of Type

testsuite/compiler/typecheck/abstract/test_B.gfs.gold

@@ -1,5 +1,6 @@
 
 
+testsuite/compiler/typecheck/abstract/B.gf:
    testsuite/compiler/typecheck/abstract/B.gf:5:
      Happened in the type of function f
       Prod expected for function S instead of Type

testsuite/compiler/typecheck/abstract/test_C.gfs.gold

@@ -1,5 +1,6 @@
 
 
+testsuite/compiler/typecheck/abstract/C.gf:
    testsuite/compiler/typecheck/abstract/C.gf:6:
      Happened in the definition of function f
       {Int <> S}

testsuite/compiler/typecheck/concrete/test_A.gfs.gold

@@ -1,5 +1,9 @@
 
 
+testsuite/compiler/typecheck/concrete/A.gf:
    testsuite/compiler/typecheck/concrete/A.gf:5:
      Happened in operation silly
       A function type is expected for a_Det instead of type Str
+      
+   ** Maybe you gave too many arguments to a_Det 
+

testsuite/libraries/exx-resource.gfs

@@ -1,226 +0,0 @@
-se utf8
-i alltenses/LangEng.gfo
-i alltenses/LangSwe.gfo
-i alltenses/LangBul.gfo
--- Adjective
-
-l -treebank PositA warm_A
-l -treebank ComparA warm_A (UsePron i_Pron)
-l -treebank ComplA2 married_A2 (UsePron she_Pron)
-l -treebank ComplA2 married_A2 (DetNP (DetQuant (PossPron she_Pron) NumPl))
-l -treebank ComplA2 married_A2 (DetNP (DetQuant (PossPron she_Pron) NumSg))
-l -treebank ReflA2 married_A2
-l -treebank PositA (UseA2 married_A2)
-l -treebank SentAP (PositA good_A) (EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseComp (CompAdv here_Adv)))))
-l -treebank AdAP very_AdA (PositA warm_A)
-
-
--- Adverb
-
-l -treebank PositAdvAdj warm_A
-l -treebank PrepNP in_Prep (DetCN (DetQuant DefArt NumSg) (UseN house_N))
-l -treebank ComparAdvAdj more_CAdv warm_A (UsePN john_PN)
-l -treebank ComparAdvAdjS more_CAdv warm_A (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV run_V)))
-l -treebank SubjS when_Subj (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V)))
-l -treebank AdNum (AdnCAdv more_CAdv) (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))
-
-
--- Conjunction
-
-l -treebank ConjS and_Conj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V))))
-l -treebank ConjAP and_Conj (BaseAP (PositA cold_A) (PositA warm_A))
-l -treebank ConjNP or_Conj (BaseNP (UsePron she_Pron) (UsePron we_Pron))
-l -treebank ConjAdv or_Conj (BaseAdv here_Adv there_Adv)
-l -treebank ConjS either7or_DConj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron he_Pron) (UseV walk_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V))))
-l -treebank ConjAP both7and_DConj (BaseAP (PositA warm_A) (PositA cold_A))
-l -treebank ConjNP either7or_DConj (BaseNP (UsePron he_Pron) (UsePron she_Pron))
-l -treebank ConjAdv both7and_DConj (BaseAdv here_Adv there_Adv)
-
--- Idiom
-
-l -treebank ImpersCl (UseComp (CompAP (PositA hot_A)))
-l -treebank GenericCl (UseV sleep_V)
-l -treebank CleftNP (UsePron i_Pron) (UseRCl (TTAnt TPast ASimul) PPos (RelVP IdRP (ComplSlash (SlashV2a do_V2) (UsePron it_Pron))))
-l -treebank CleftAdv here_Adv (UseCl (TTAnt TPast ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V)))
-l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (UseN house_N))
-l -treebank ExistIP (IdetCN (IdetQuant which_IQuant NumPl) (UseN house_N))
-l -treebank PredVP (UsePron i_Pron) (ProgrVP (UseV sleep_V))
-l -treebank ImpPl1 (UseV go_V)
-
--- Noun
-
-l -treebank DetCN (DetQuant DefArt NumSg) (UseN man_N)
-l -treebank UsePN john_PN
-l -treebank UsePron he_Pron
-l -treebank PredetNP only_Predet (DetCN (DetQuant DefArt NumSg) (UseN man_N))
-l -treebank PPartNP (DetCN (DetQuant DefArt NumSg) (UseN man_N)) see_V2
-l -treebank AdvNP (UsePN paris_PN) today_Adv
-l -treebank RelNP (UsePN paris_PN) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (UseComp (CompAdv here_Adv))))
-l -treebank DetNP (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))))
-l -treebank DetCN (DetQuantOrd this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N)
-l -treebank DetCN (DetQuant this_Quant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N)
-l -treebank DetCN (DetQuant this_Quant NumPl) (UseN man_N)
-l -treebank DetCN (DetQuant this_Quant NumSg) (UseN man_N)
-l -treebank NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))
-l -treebank NumCard (NumDigits (IIDig D_5 (IDig D_1)))
-l -treebank NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01)))))
-l -treebank NumCard (AdNum almost_AdN (NumDigits (IIDig D_5 (IDig D_1))))
-l -treebank OrdDigits (IIDig D_5 (IDig D_1))
-l -treebank OrdNumeral (num (pot2as3 (pot1as2 (pot1plus n5 pot01))))
-l -treebank OrdSuperl warm_A
-l -treebank DetCN (DetQuantOrd DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))) (OrdSuperl good_A)) (UseN man_N)
-l -treebank DetCN (DetQuant DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN man_N)
-l -treebank DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01))))))) (UseN man_N)
-l -treebank DetCN (DetQuant DefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 pot01))))))) (UseN man_N)
-l -treebank DetCN (DetQuant DefArt NumSg) (UseN man_N)
-l -treebank DetCN (DetQuant DefArt NumPl) (UseN man_N)
-l -treebank MassNP (UseN beer_N)
-l -treebank DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN house_N)
-l -treebank UseN house_N
-l -treebank ComplN2 mother_N2 (DetCN (DetQuant DefArt NumSg) (UseN king_N))
-l -treebank ComplN2 (ComplN3 distance_N3 (DetCN (DetQuant this_Quant NumSg) (UseN city_N))) (UsePN paris_PN)
-l -treebank UseN2 mother_N2
-l -treebank ComplN2 (Use2N3 distance_N3) (DetCN (DetQuant this_Quant NumSg) (UseN city_N))
-l -treebank ComplN2 (Use3N3 distance_N3) (UsePN paris_PN)
-l -treebank UseN2 (Use2N3 distance_N3)
-l -treebank AdjCN (PositA big_A) (UseN house_N)
-l -treebank RelCN (UseN house_N) (UseRCl (TTAnt TPast ASimul) PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a buy_V2))))
-l -treebank AdvCN (UseN house_N) (PrepNP on_Prep (DetCN (DetQuant DefArt NumSg) (UseN hill_N)))
-l -treebank SentCN (UseN question_N) (EmbedQS (UseQCl (TTAnt TPres ASimul) PPos (QuestIAdv where_IAdv (PredVP (UsePron she_Pron) (UseV sleep_V)))))
-l -treebank DetCN (DetQuant DefArt NumSg) (ApposCN (UseN city_N) (UsePN paris_PN))
-l -treebank DetCN (DetQuant (PossPron i_Pron) NumSg) (ApposCN (UseN friend_N) (UsePN john_PN))
-
--- Numeral
-
-l -treebank num (pot2as3 (pot1as2 (pot0as1 (pot0 n6))))
-l -treebank num (pot2as3 (pot1as2 (pot0as1 pot01)))
-l -treebank num (pot2as3 (pot1as2 (pot1 n6)))
-l -treebank num (pot2as3 (pot1as2 pot110))
-l -treebank num (pot2as3 (pot1as2 pot111))
-l -treebank num (pot2as3 (pot1as2 (pot1to19 n6)))
-l -treebank num (pot2as3 (pot1as2 (pot1 n6)))
-l -treebank num (pot2as3 (pot1as2 (pot1plus n6 (pot0 n5))))
-l -treebank num (pot2as3 (pot2 (pot0 n4)))
-l -treebank num (pot2as3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))))
-l -treebank num (pot3 (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))))
-l -treebank num (pot3plus (pot2plus (pot0 n4) (pot1plus n6 (pot0 n7))) (pot1as2 (pot1plus n8 (pot0 n9))))
-l -treebank IDig D_8
-l -treebank IIDig D_8 (IIDig D_0 (IIDig D_0 (IIDig D_1 (IIDig D_7 (IIDig D_8 (IDig D_9))))))
-
-
--- Phrase
-
-l -treebank PhrUtt but_PConj (UttImpSg PPos (ImpVP (AdvVP (UseV come_V) here_Adv))) (VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N)))
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc
-l -treebank UttQS (UseQCl (TTAnt TPres ASimul) PPos (QuestCl (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A))))))
-l -treebank UttImpSg PNeg (ImpVP (ReflVP (SlashV2a love_V2)))
-l -treebank UttImpPl PNeg (ImpVP (ReflVP (SlashV2a love_V2)))
-l -treebank UttImpPol PNeg (ImpVP (UseV sleep_V))
-l -treebank UttIP whoPl_IP
-l -treebank UttIP whoSg_IP
-l -treebank UttIAdv why_IAdv
-l -treebank UttNP (DetCN (DetQuant this_Quant NumSg) (UseN man_N))
-l -treebank UttAdv here_Adv
-l -treebank UttVP (UseV sleep_V)
-l -treebank VocNP (DetCN (DetQuant (PossPron i_Pron) NumSg) (UseN friend_N))
-
-
--- Question
-
-l -treebank QuestCl (PredVP (UsePN john_PN) (UseV walk_V))
-l -treebank QuestVP whoSg_IP (UseV walk_V)
-l -treebank QuestSlash whoSg_IP (SlashVP (UsePN john_PN) (SlashV2a love_V2))
-l -treebank QuestIAdv why_IAdv (PredVP (UsePN john_PN) (UseV walk_V))
-l -treebank QuestIComp (CompIAdv where_IAdv) (UsePN john_PN)
-l -treebank IdetCN (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5)))))))) (UseN song_N)
-l -treebank IdetIP (IdetQuant which_IQuant (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n5))))))))
-l -treebank AdvIP whoSg_IP (PrepNP in_Prep (UsePN paris_PN))
-l -treebank IdetIP (IdetQuant which_IQuant NumSg)
-l -treebank PrepIP with_Prep whoSg_IP
-l -treebank QuestIComp (CompIAdv where_IAdv) (UsePron it_Pron)
-l -treebank QuestIComp (CompIP whoSg_IP) (UsePron it_Pron)
-
-
--- Relative
-
-l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelCl (PredVP (UsePN john_PN) (ComplSlash (SlashV2a love_V2) (UsePron she_Pron)))))))
-l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (ComplSlash (SlashV2a love_V2) (UsePN john_PN))))))
-l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePN john_PN) (SlashV2a love_V2))))))
-l -treebank ExistNP (DetCN (DetQuant IndefArt NumSg) (RelCN (UseN woman_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash (FunRP possess_Prep (DetCN (DetQuant DefArt NumSg) (UseN2 mother_N2)) IdRP) (SlashVP (UsePN john_PN) (SlashV2a love_V2))))))
-
--- Sentence
-
-l -treebank PredVP (UsePN john_PN) (UseV walk_V)
-l -treebank PredSCVP (EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV go_V)))) (UseComp (CompAP (PositA good_A)))
-l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron he_Pron) (SlashV2a see_V2))))
-l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (AdvSlash (SlashVP (UsePron he_Pron) (SlashV2a see_V2)) today_Adv)))
-l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron he_Pron) (UseV walk_V)) with_Prep)))
-l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVS (UsePron she_Pron) say_VS (UseSlash (TTAnt TPres ASimul) PPos (SlashVP (UsePron he_Pron) (SlashV2a love_V2))))))
-l -treebank ImpVP (ReflVP (SlashV2a love_V2))
-l -treebank EmbedS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV go_V)))
-l -treebank EmbedQS (UseQCl (TTAnt TPres ASimul) PPos (QuestVP whoSg_IP (UseV go_V)))
-l -treebank EmbedVP (UseV go_V)
-l -treebank UseCl (TTAnt TCond AAnter) PNeg (PredVP (UsePN john_PN) (UseV walk_V))
-l -treebank UseQCl (TTAnt TCond AAnter) PNeg (QuestCl (PredVP (UsePN john_PN) (UseV walk_V)))
-l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TCond AAnter) PNeg (RelVP IdRP (UseV walk_V)))
-l -treebank RelCN (UseN girl_N) (UseRCl (TTAnt TCond AAnter) PNeg (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (UseV walk_V)) with_Prep)))
-l -treebank RelS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV sleep_V))) (UseRCl (TTAnt TPres ASimul) PPos (RelVP IdRP (UseComp (CompAP (PositA good_A)))))
-
-
--- Text
-
-l -treebank TEmpty
-l -treebank TFullStop (PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePN john_PN) (UseV walk_V)))) NoVoc) TEmpty
-l -treebank TQuestMark (PhrUtt NoPConj (UttQS (UseQCl (TTAnt TPres ASimul) PPos (QuestCl (PredVP (UsePron they_Pron) (UseComp (CompAdv here_Adv)))))) NoVoc) TEmpty
-l -treebank TExclMark (PhrUtt NoPConj (ImpPl1 (UseV go_V)) NoVoc) TEmpty
-
--- Verb
-
-l -treebank PredVP (UsePron i_Pron) (UseV sleep_V)
-l -treebank PredVP (UsePron i_Pron) (ComplVV want_VV (UseV run_V))
-l -treebank PredVP (UsePron i_Pron) (ComplVS say_VS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron she_Pron) (UseV run_V))))
-l -treebank PredVP (UsePron i_Pron) (ComplVQ wonder_VQ (UseQCl (TTAnt TPres ASimul) PPos (QuestVP whoSg_IP (UseV run_V))))
-l -treebank PredVP (UsePron they_Pron) (ComplVA become_VA (PositA red_A))
-l -treebank PredVP (UsePron i_Pron) (ComplSlash (Slash3V3 give_V3 (UsePron he_Pron)) (UsePron it_Pron))
-l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2V beg_V2V (UseV go_V)) (UsePron she_Pron))
-l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2S answer_V2S (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron it_Pron) (UseComp (CompAP (PositA good_A)))))) (UsePron he_Pron))
-l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2Q ask_V2Q (UseQCl (TTAnt TPast ASimul) PPos (QuestVP whoSg_IP (UseV come_V)))) (UsePron he_Pron))
-l -treebank PredVP (UsePron i_Pron) (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron))
-l -treebank RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2a buy_V2)))))
-l -treebank RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2)))))
-l -treebank PredVP (UsePron he_Pron) (ReflVP (SlashV2a love_V2))
-l -treebank PredVP (DetNP (DetQuant this_Quant NumSg)) (UseComp (CompAP (PositA warm_A)))
-l -treebank PredVP (UsePron we_Pron) (PassV2 love_V2)
-l -treebank PredVP (UsePron we_Pron) (AdvVP (UseV sleep_V) here_Adv)
-l -treebank PredVP (UsePron we_Pron) (AdVVP always_AdV (UseV sleep_V))
-l -treebank PredVP (UsePron we_Pron) (UseComp (CompAP (PositA small_A)))
-l -treebank PredVP (UsePron i_Pron) (UseComp (CompNP (DetCN (DetQuant IndefArt NumSg) (UseN man_N))))
-l -treebank PredVP (UsePron i_Pron) (UseComp (CompAdv here_Adv))
-
-
-
--- Janna's and Krasimir's long examples
-
-l -treebank RelCN (UseN car_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron they_Pron) (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashVV want_VV (SlashV2A paint_V2A (PositA red_A)))))))
-l -treebank PhrUtt NoPConj (UttImpSg PPos (ImpVP (AdVVP always_AdV (ComplSlash (SlashV2a listen_V2) (DetCN (DetQuant DefArt NumSg) (UseN sea_N)))))) NoVoc
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (ExistNP (PredetNP only_Predet (DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot0as1 (pot0 n2)))))))) (AdvCN (RelCN (UseN woman_N) (UseRCl (TTAnt TCond ASimul) PPos (RelSlash IdRP (SlashPrep (PredVP (UsePron i_Pron) (ComplVV want_VV (PassV2 see_V2))) with_Prep)))) (PrepNP in_Prep (DetCN (DetQuant DefArt NumSg) (UseN rain_N))))))))) NoVoc
-l -treebank PhrUtt NoPConj (UttImpSg  PPos (ImpVP (ComplSlash (SlashV2A paint_V2A (ConjAP both7and_DConj (BaseAP (ComparA small_A (DetCN (DetQuant DefArt NumSg) (UseN sun_N))) (ComparA big_A (DetCN (DetQuant DefArt NumSg) (UseN moon_N)))))) (DetCN (DetQuant DefArt NumSg) (UseN earth_N))))) NoVoc
-l -treebank PhrUtt NoPConj (ImpPl1 (ComplVS hope_VS (ConjS either7or_DConj (BaseS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumSg) (ComplN2 father_N2 (DetCN (DetQuant DefArt NumSg) (UseN baby_N)))) (UseV run_V))) (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumSg) (UseN2 (Use2N3 distance_N3))) (UseComp (CompAP (PositA small_A))))))))) NoVoc
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN every_Det (UseN baby_N)) (UseComp (CompNP (ConjNP either7or_DConj (BaseNP (DetCN (DetQuant IndefArt NumSg) (UseN boy_N)) (DetCN (DetQuant IndefArt NumSg) (UseN girl_N))))))))) NoVoc
-l -treebank PhrUtt NoPConj (UttAdv (ConjAdv either7or_DConj (ConsAdv here7from_Adv (BaseAdv there_Adv everywhere_Adv)))) NoVoc
-l -treebank PhrUtt NoPConj (UttVP (PassV2 know_V2)) NoVoc
-l -treebank RelCN (UseN bird_N) (UseRCl (TTAnt TPres ASimul) PPos (RelSlash IdRP (SlashVP (UsePron i_Pron) (SlashVV want_VV (SlashV2A paint_V2A (PositA red_A))))))
-l -treebank UttImpSg PPos (ImpVP (ComplVV want_VV (ComplSlash (SlashV2a buy_V2) (UsePron it_Pron))))
-l -treebank UttImpSg PPos (ImpVP (ComplVV want_VV (ComplSlash (SlashV2A paint_V2A (PositA red_A)) (UsePron it_Pron))))
-l -treebank UttImpSg PPos (ImpVP (ComplSlash (SlashVV want_VV (SlashV2VNP beg_V2V (UsePron i_Pron) (SlashV2a buy_V2))) (UsePron it_Pron)))
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant DefArt NumPl) (UseN fruit_N)) (ReflVP (Slash3V3 sell_V3 (DetCN (DetQuant DefArt NumSg) (UseN road_N))))))) NoVoc
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2V beg_V2V (UseV live_V)))))) NoVoc
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2S answer_V2S (UseCl (TTAnt TPres ASimul) PPos (ImpersCl (ComplVV must_VV (ReflVP (SlashV2a understand_V2)))))))))) NoVoc
-l -treebank PhrUtt NoPConj (UttImpSg PPos (ImpVP (ReflVP (SlashV2Q ask_V2Q (UseQCl (TTAnt TPast ASimul) PPos (QuestVP whoSg_IP (UseV come_V))))))) NoVoc
-l -treebank PhrUtt NoPConj (UttS (UseCl (TTAnt TPast ASimul) PPos (PredVP (UsePron i_Pron) (ReflVP (SlashV2A paint_V2A (ComparA beautiful_A (UsePN john_PN))))))) NoVoc
-
--- more long examples
-
-l -treebank UttS (UseCl (TTAnt TPres ASimul) PPos (PredVP (DetCN (DetQuant this_Quant NumSg) (UseN grammar_N)) (ComplSlash (SlashV2a speak_V2) (DetCN (DetQuant IndefArt (NumCard (NumNumeral (num (pot2as3 (pot1as2 (pot1to19 n2))))))) (UseN language_N)))))
-l -treebank UseCl (TTAnt TPast AAnter) PPos (PredVP (UsePron she_Pron) (ComplSlash (SlashV2a buy_V2) (DetCN (DetQuant IndefArt NumSg) (AdjCN (PositA red_A) (UseN house_N)))))
-

testsuite/run.hs

@@ -1,7 +1,7 @@
 import Data.List(partition)
 import System.IO
 import Distribution.Simple.BuildPaths(exeExtension)
-import Distribution.System ( buildPlatform )
+import Distribution.System ( buildPlatform, OS (Windows), Platform (Platform) )
 import System.Process(readProcess)
 import System.Directory(doesFileExist,getDirectoryContents)
 import System.FilePath((</>),(<.>),takeExtension)
@@ -11,10 +11,10 @@ main =
    do res <- walk "testsuite"
       let cnt = length res
           (good,bad) = partition ((=="OK").fst.snd) res
-          ok = length good
+          ok = length good + length (filter ((=="FAIL (expected)").fst.snd) bad)
           fail = ok<cnt
       putStrLn $ show ok++"/"++show cnt++ " passed/tests"
-      let overview = "dist/test/gf-tests.html"
+      let overview = "gf-tests.html"
       writeFile overview (toHTML bad)
       if ok<cnt 
         then do putStrLn $ overview++" contains an overview of the failed tests"
@@ -55,13 +55,15 @@ main =
 
     runTest in_file out_file gold_file = do
       input <- readFile in_file
-      writeFile out_file =<< run_gf input
+      writeFile out_file =<< run_gf ["-run"] input
       exists <- doesFileExist gold_file
       if exists
         then do out <- compatReadFile out_file
                 gold <- compatReadFile gold_file
                 let info = (input,gold,out)
-                return $! if out == gold then ("OK",info) else ("FAIL",info)
+                if in_file `elem` expectedFailures
+                  then return $! if out == gold then ("Unexpected success",info) else ("FAIL (expected)",info)
+                  else return $! if out == gold then ("OK",info) else ("FAIL",info)
         else do out <- compatReadFile out_file
                 return ("MISSING GOLD",(input,"",out))
     -- Avoid failures caused by Win32/Unix text file incompatibility
@@ -70,10 +72,21 @@ main =
          hSetNewlineMode h universalNewlineMode
          hGetContents h
 
+expectedFailures :: [String]
+expectedFailures =
+  [ "testsuite/runtime/parser/parser.gfs" -- Only parses `z` as `zero` and not also as e.g. `succ zero` as expected
+  , "testsuite/runtime/linearize/brackets.gfs" -- Missing "cannot linearize in the end"
+  , "testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs" -- Gives a different error than expected
+  ]
+
 -- Should consult the Cabal configuration!
-run_gf = readProcess default_gf ["-run","-gf-lib-path="++gf_lib_path]
+run_gf = readProcess default_gf 
-default_gf = "dist/build/gf/gf"<.>exeExtension buildPlatform
+default_gf = "gf"<.>exeExtension
-gf_lib_path = "dist/build/rgl"
+  where
+    -- shadows Distribution.Simple.BuildPaths.exeExtension, which changed type signature in Cabal 2.4
+    exeExtension = case buildPlatform of
+      Platform arch Windows -> "exe"
+      _ -> ""
 
 -- | List files, excluding "." and ".."
 ls path = filter (`notElem` [".",".."]) `fmap` getDirectoryContents path

testsuite/runtime/linearize/brackets.gfs.gold

@@ -1,28 +1,19 @@
 (S:2 (E:1 (_:0 ?1)) is even)
 
-
 (S:3 exists x such that (S:2 (E:1 (_:0 x)) is even))
 
-
 (S:1 (E:0 a))
 
-
 (S:1 (E:0 aa) a)
 
-
 (S:1 (E:0 a) b)
 
-
 (S:1 (String:0 abcd) is string)
 
-
 (S:1 (Int:0 100) is integer)
 
-
 (S:1 (Float:0 12.4) is float)
 
-
 (S:1 (String:0 xyz) is string)
 
-
  cannot linearize

testsuite/runtime/linearize/linearize.gfs.gold

@@ -1,30 +1,20 @@
 ?1 is even
 
-
 exists x such that x is even
 
-
 a
 
-
 aa a
 
-
 a b
 
-
 abcd is string
 
-
 100 is integer
 
-
 12.4 is float
 
-
 xyz is string
 
 
 
-
-