GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-21 09:02:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into lpgf

Browse Source 
# Conflicts:
#	gf.cabal
#	src/compiler/GF/Compile/GrammarToCanonical.hs
#	src/compiler/GF/Grammar/Canonical.hs
#	src/compiler/GF/Infra/Option.hs
This commit is contained in:
John J. Camilleri
2021-07-07 08:36:09 +02:00
parent c1af40532c 0886eb520d
commit 4bd26eae6d
93 changed files with 2437 additions and 3275 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
testsuite/canonical/.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
canonical/

102
testsuite/canonical/gold/FoodsFin.gf Normal file
View File

@@ -0,0 +1,102 @@
concrete FoodsFin of Foods = {
param ParamX_Number = ParamX_Sg | ParamX_Pl;
param Prelude_Bool = Prelude_False | Prelude_True;
param ResFin_Agr = ResFin_Ag ParamX_Number ParamX_Person | ResFin_AgPol;
param ParamX_Person = ParamX_P1 | ParamX_P2 | ParamX_P3;
param ResFin_Harmony = ResFin_Back | ResFin_Front;
param ResFin_NForm =
ResFin_NCase ParamX_Number ResFin_Case | ResFin_NComit | ResFin_NInstruct |
ResFin_NPossNom ParamX_Number | ResFin_NPossGen ParamX_Number |
ResFin_NPossTransl ParamX_Number | ResFin_NPossIllat ParamX_Number |
ResFin_NCompound;
param ResFin_Case =
ResFin_Nom | ResFin_Gen | ResFin_Part | ResFin_Transl | ResFin_Ess |
ResFin_Iness | ResFin_Elat | ResFin_Illat | ResFin_Adess | ResFin_Ablat |
ResFin_Allat | ResFin_Abess;
param ResFin_NPForm = ResFin_NPCase ResFin_Case | ResFin_NPAcc | ResFin_NPSep;
lincat Comment = {s : Str};
Item =
{s : ResFin_NPForm => Str; a : ResFin_Agr; isNeg : Prelude_Bool;
isPron : Prelude_Bool};
Kind =
{s : ResFin_NForm => Str; h : ResFin_Harmony;
postmod : ParamX_Number => Str};
Quality =
{s : Prelude_Bool => ResFin_NForm => Str; hasPrefix : Prelude_Bool;
p : Str};
lin Expensive =
{s =
table {Prelude_False =>
table {ResFin_NCase ParamX_Sg ResFin_Nom => "kallis";
ResFin_NCase ParamX_Sg ResFin_Gen => "kalliin";
ResFin_NCase ParamX_Sg ResFin_Part => "kallista";
ResFin_NCase ParamX_Sg ResFin_Transl => "kalliiksi";
ResFin_NCase ParamX_Sg ResFin_Ess => "kalliina";
ResFin_NCase ParamX_Sg ResFin_Iness => "kalliissa";
ResFin_NCase ParamX_Sg ResFin_Elat => "kalliista";
ResFin_NCase ParamX_Sg ResFin_Illat => "kalliiseen";
ResFin_NCase ParamX_Sg ResFin_Adess => "kalliilla";
ResFin_NCase ParamX_Sg ResFin_Ablat => "kalliilta";
ResFin_NCase ParamX_Sg ResFin_Allat => "kalliille";
ResFin_NCase ParamX_Sg ResFin_Abess => "kalliitta";
ResFin_NCase ParamX_Pl ResFin_Nom => "kalliit";
ResFin_NCase ParamX_Pl ResFin_Gen => "kalliiden";
ResFin_NCase ParamX_Pl ResFin_Part => "kalliita";
ResFin_NCase ParamX_Pl ResFin_Transl => "kalliiksi";
ResFin_NCase ParamX_Pl ResFin_Ess => "kalliina";
ResFin_NCase ParamX_Pl ResFin_Iness => "kalliissa";
ResFin_NCase ParamX_Pl ResFin_Elat => "kalliista";
ResFin_NCase ParamX_Pl ResFin_Illat => "kalliisiin";
ResFin_NCase ParamX_Pl ResFin_Adess => "kalliilla";
ResFin_NCase ParamX_Pl ResFin_Ablat => "kalliilta";
ResFin_NCase ParamX_Pl ResFin_Allat => "kalliille";
ResFin_NCase ParamX_Pl ResFin_Abess => "kalliitta";
ResFin_NComit => "kalliine";
ResFin_NInstruct => "kalliin";
ResFin_NPossNom ParamX_Sg => "kallii";
ResFin_NPossNom ParamX_Pl => "kallii";
ResFin_NPossGen ParamX_Sg => "kallii";
ResFin_NPossGen ParamX_Pl => "kalliide";
ResFin_NPossTransl ParamX_Sg => "kalliikse";
ResFin_NPossTransl ParamX_Pl => "kalliikse";
ResFin_NPossIllat ParamX_Sg => "kalliisee";
ResFin_NPossIllat ParamX_Pl => "kalliisii";
ResFin_NCompound => "kallis"};
Prelude_True =>
table {ResFin_NCase ParamX_Sg ResFin_Nom => "kallis";
ResFin_NCase ParamX_Sg ResFin_Gen => "kalliin";
ResFin_NCase ParamX_Sg ResFin_Part => "kallista";
ResFin_NCase ParamX_Sg ResFin_Transl => "kalliiksi";
ResFin_NCase ParamX_Sg ResFin_Ess => "kalliina";
ResFin_NCase ParamX_Sg ResFin_Iness => "kalliissa";
ResFin_NCase ParamX_Sg ResFin_Elat => "kalliista";
ResFin_NCase ParamX_Sg ResFin_Illat => "kalliiseen";
ResFin_NCase ParamX_Sg ResFin_Adess => "kalliilla";
ResFin_NCase ParamX_Sg ResFin_Ablat => "kalliilta";
ResFin_NCase ParamX_Sg ResFin_Allat => "kalliille";
ResFin_NCase ParamX_Sg ResFin_Abess => "kalliitta";
ResFin_NCase ParamX_Pl ResFin_Nom => "kalliit";
ResFin_NCase ParamX_Pl ResFin_Gen => "kalliiden";
ResFin_NCase ParamX_Pl ResFin_Part => "kalliita";
ResFin_NCase ParamX_Pl ResFin_Transl => "kalliiksi";
ResFin_NCase ParamX_Pl ResFin_Ess => "kalliina";
ResFin_NCase ParamX_Pl ResFin_Iness => "kalliissa";
ResFin_NCase ParamX_Pl ResFin_Elat => "kalliista";
ResFin_NCase ParamX_Pl ResFin_Illat => "kalliisiin";
ResFin_NCase ParamX_Pl ResFin_Adess => "kalliilla";
ResFin_NCase ParamX_Pl ResFin_Ablat => "kalliilta";
ResFin_NCase ParamX_Pl ResFin_Allat => "kalliille";
ResFin_NCase ParamX_Pl ResFin_Abess => "kalliitta";
ResFin_NComit => "kalliine";
ResFin_NInstruct => "kalliin";
ResFin_NPossNom ParamX_Sg => "kallii";
ResFin_NPossNom ParamX_Pl => "kallii";
ResFin_NPossGen ParamX_Sg => "kallii";
ResFin_NPossGen ParamX_Pl => "kalliide";
ResFin_NPossTransl ParamX_Sg => "kalliikse";
ResFin_NPossTransl ParamX_Pl => "kalliikse";
ResFin_NPossIllat ParamX_Sg => "kalliisee";
ResFin_NPossIllat ParamX_Pl => "kalliisii";
ResFin_NCompound => "kallis"}};
hasPrefix = Prelude_False; p = ""};
}

29
testsuite/canonical/gold/PhrasebookBul.gf Normal file
View File

@@ -0,0 +1,29 @@
concrete PhrasebookBul of Phrasebook = {
param Prelude_Bool = Prelude_False | Prelude_True;
param ResBul_AGender = ResBul_AMasc ResBul_Animacy | ResBul_AFem | ResBul_ANeut;
param ResBul_Animacy = ResBul_Human | ResBul_NonHuman;
param ResBul_Case = ResBul_Acc | ResBul_Dat | ResBul_WithPrep | ResBul_CPrep;
param ResBul_NForm =
ResBul_NF ParamX_Number ResBul_Species | ResBul_NFSgDefNom |
ResBul_NFPlCount | ResBul_NFVocative;
param ParamX_Number = ParamX_Sg | ParamX_Pl;
param ResBul_Species = ResBul_Indef | ResBul_Def;
lincat PlaceKind =
{at : {s : Str; c : ResBul_Case}; isPl : Prelude_Bool;
name : {s : ResBul_NForm => Str; g : ResBul_AGender};
to : {s : Str; c : ResBul_Case}};
VerbPhrase = {s : Str};
lin Airport =
{at = {s = "на"; c = ResBul_Acc}; isPl = Prelude_False;
name =
{s =
table {ResBul_NF ParamX_Sg ResBul_Indef => "летище";
ResBul_NF ParamX_Sg ResBul_Def => "летището";
ResBul_NF ParamX_Pl ResBul_Indef => "летища";
ResBul_NF ParamX_Pl ResBul_Def => "летищата";
ResBul_NFSgDefNom => "летището";
ResBul_NFPlCount => "летища";
ResBul_NFVocative => "летище"};
g = ResBul_ANeut};
to = {s = "до"; c = ResBul_CPrep}};
}

251
testsuite/canonical/gold/PhrasebookGer.gf Normal file
View File

@@ -0,0 +1,251 @@
concrete PhrasebookGer of Phrasebook = {
param Prelude_Bool = Prelude_False | Prelude_True;
param ResGer_Agr = ResGer_Ag ResGer_Gender ParamX_Number ParamX_Person;
param ParamX_Number = ParamX_Sg | ParamX_Pl;
param ParamX_Person = ParamX_P1 | ParamX_P2 | ParamX_P3;
param ResGer_Gender = ResGer_Masc | ResGer_Fem | ResGer_Neutr;
param ResGer_Control = ResGer_SubjC | ResGer_ObjC | ResGer_NoC;
param ResGer_PCase = ResGer_NPC ResGer_Case | ResGer_NPP ResGer_CPrep;
param ResGer_CPrep =
ResGer_CAnDat | ResGer_CInAcc | ResGer_CInDat | ResGer_CZuDat |
ResGer_CVonDat;
param ResGer_Case = ResGer_Nom | ResGer_Acc | ResGer_Dat | ResGer_Gen;
param ResGer_VAux = ResGer_VHaben | ResGer_VSein;
param ResGer_VForm =
ResGer_VInf Prelude_Bool | ResGer_VFin Prelude_Bool ResGer_VFormFin |
ResGer_VImper ParamX_Number | ResGer_VPresPart ResGer_AForm |
ResGer_VPastPart ResGer_AForm;
param ResGer_AForm = ResGer_APred | ResGer_AMod ResGer_GenNum ResGer_Case;
param ResGer_GenNum = ResGer_GSg ResGer_Gender | ResGer_GPl;
param ResGer_VFormFin =
ResGer_VPresInd ParamX_Number ParamX_Person |
ResGer_VPresSubj ParamX_Number ParamX_Person;
param ResGer_VType = ResGer_VAct | ResGer_VRefl ResGer_Case;
lincat PlaceKind = {s : Str};
VerbPhrase =
{s :
{s : ResGer_VForm => Str; aux : ResGer_VAux; particle : Str;
prefix : Str; vtype : ResGer_VType};
a1 : Str; a2 : Str; adj : Str; ext : Str;
inf : {s : Str; ctrl : ResGer_Control; isAux : Prelude_Bool};
infExt : Str; isAux : Prelude_Bool;
nn :
ResGer_Agr =>
{p1 : Str; p2 : Str; p3 : Str; p4 : Str; p5 : Str; p6 : Str};
subjc :
{s : Str; c : ResGer_PCase; isPrep : Prelude_Bool; s2 : Str}};
lin VRead =
{s =
{s =
table {ResGer_VInf Prelude_False => "lesen";
ResGer_VInf Prelude_True => "zu" ++ "lesen";
ResGer_VFin Prelude_False
(ResGer_VPresInd ParamX_Sg ParamX_P1) =>
"lese";
ResGer_VFin Prelude_False
(ResGer_VPresInd ParamX_Sg ParamX_P2) =>
"liest";
ResGer_VFin Prelude_False
(ResGer_VPresInd ParamX_Sg ParamX_P3) =>
"liest";
ResGer_VFin Prelude_False
(ResGer_VPresInd ParamX_Pl ParamX_P1) =>
"lesen";
ResGer_VFin Prelude_False
(ResGer_VPresInd ParamX_Pl ParamX_P2) =>
"lest";
ResGer_VFin Prelude_False
(ResGer_VPresInd ParamX_Pl ParamX_P3) =>
"lesen";
ResGer_VFin Prelude_False
(ResGer_VPresSubj ParamX_Sg ParamX_P1) =>
"lese";
ResGer_VFin Prelude_False
(ResGer_VPresSubj ParamX_Sg ParamX_P2) =>
"lesest";
ResGer_VFin Prelude_False
(ResGer_VPresSubj ParamX_Sg ParamX_P3) =>
"lese";
ResGer_VFin Prelude_False
(ResGer_VPresSubj ParamX_Pl ParamX_P1) =>
"lesen";
ResGer_VFin Prelude_False
(ResGer_VPresSubj ParamX_Pl ParamX_P2) =>
"leset";
ResGer_VFin Prelude_False
(ResGer_VPresSubj ParamX_Pl ParamX_P3) =>
"lesen";
ResGer_VFin Prelude_True
(ResGer_VPresInd ParamX_Sg ParamX_P1) =>
"lese";
ResGer_VFin Prelude_True
(ResGer_VPresInd ParamX_Sg ParamX_P2) =>
"liest";
ResGer_VFin Prelude_True
(ResGer_VPresInd ParamX_Sg ParamX_P3) =>
"liest";
ResGer_VFin Prelude_True
(ResGer_VPresInd ParamX_Pl ParamX_P1) =>
"lesen";
ResGer_VFin Prelude_True
(ResGer_VPresInd ParamX_Pl ParamX_P2) =>
"lest";
ResGer_VFin Prelude_True
(ResGer_VPresInd ParamX_Pl ParamX_P3) =>
"lesen";
ResGer_VFin Prelude_True
(ResGer_VPresSubj ParamX_Sg ParamX_P1) =>
"lese";
ResGer_VFin Prelude_True
(ResGer_VPresSubj ParamX_Sg ParamX_P2) =>
"lesest";
ResGer_VFin Prelude_True
(ResGer_VPresSubj ParamX_Sg ParamX_P3) =>
"lese";
ResGer_VFin Prelude_True
(ResGer_VPresSubj ParamX_Pl ParamX_P1) =>
"lesen";
ResGer_VFin Prelude_True
(ResGer_VPresSubj ParamX_Pl ParamX_P2) =>
"leset";
ResGer_VFin Prelude_True
(ResGer_VPresSubj ParamX_Pl ParamX_P3) =>
"lesen";
ResGer_VImper ParamX_Sg => "les";
ResGer_VImper ParamX_Pl => "lest";
ResGer_VPresPart ResGer_APred => "lesend";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Nom) =>
"lesender";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Acc) =>
"lesenden";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Dat) =>
"lesendem";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Gen) =>
"lesenden";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Nom) =>
"lesende";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Acc) =>
"lesende";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Dat) =>
"lesender";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Gen) =>
"lesender";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Nom) =>
"lesendes";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Acc) =>
"lesendes";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Dat) =>
"lesendem";
ResGer_VPresPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Gen) =>
"lesenden";
ResGer_VPresPart (ResGer_AMod ResGer_GPl ResGer_Nom) =>
"lesende";
ResGer_VPresPart (ResGer_AMod ResGer_GPl ResGer_Acc) =>
"lesende";
ResGer_VPresPart (ResGer_AMod ResGer_GPl ResGer_Dat) =>
"lesenden";
ResGer_VPresPart (ResGer_AMod ResGer_GPl ResGer_Gen) =>
"lesender";
ResGer_VPastPart ResGer_APred => "gelesen";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Nom) =>
"gelesener";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Acc) =>
"gelesenen";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Dat) =>
"gelesenem";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Masc)
ResGer_Gen) =>
"gelesenen";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Nom) =>
"gelesene";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Acc) =>
"gelesene";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Dat) =>
"gelesener";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Fem)
ResGer_Gen) =>
"gelesener";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Nom) =>
"gelesenes";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Acc) =>
"gelesenes";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Dat) =>
"gelesenem";
ResGer_VPastPart (ResGer_AMod (ResGer_GSg ResGer_Neutr)
ResGer_Gen) =>
"gelesenen";
ResGer_VPastPart (ResGer_AMod ResGer_GPl ResGer_Nom) =>
"gelesene";
ResGer_VPastPart (ResGer_AMod ResGer_GPl ResGer_Acc) =>
"gelesene";
ResGer_VPastPart (ResGer_AMod ResGer_GPl ResGer_Dat) =>
"gelesenen";
ResGer_VPastPart (ResGer_AMod ResGer_GPl ResGer_Gen) =>
"gelesener"};
aux = ResGer_VHaben; particle = ""; prefix = "";
vtype = ResGer_VAct};
a1 = ""; a2 = ""; adj = ""; ext = "";
inf = {s = ""; ctrl = ResGer_NoC; isAux = Prelude_True}; infExt = "";
isAux = Prelude_False;
nn =
table {ResGer_Ag ResGer_Masc ParamX_Sg ParamX_P1 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Masc ParamX_Sg ParamX_P2 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Masc ParamX_Sg ParamX_P3 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Masc ParamX_Pl ParamX_P1 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Masc ParamX_Pl ParamX_P2 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Masc ParamX_Pl ParamX_P3 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Fem ParamX_Sg ParamX_P1 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Fem ParamX_Sg ParamX_P2 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Fem ParamX_Sg ParamX_P3 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Fem ParamX_Pl ParamX_P1 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Fem ParamX_Pl ParamX_P2 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Fem ParamX_Pl ParamX_P3 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Neutr ParamX_Sg ParamX_P1 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Neutr ParamX_Sg ParamX_P2 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Neutr ParamX_Sg ParamX_P3 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Neutr ParamX_Pl ParamX_P1 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Neutr ParamX_Pl ParamX_P2 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""};
ResGer_Ag ResGer_Neutr ParamX_Pl ParamX_P3 =>
{p1 = ""; p2 = ""; p3 = ""; p4 = ""; p5 = ""; p6 = ""}};
subjc =
{s = ""; c = ResGer_NPC ResGer_Nom; isPrep = Prelude_False;
s2 = ""}};
}

16
testsuite/canonical/grammars/Foods.gf Normal file
View File

@@ -0,0 +1,16 @@
-- (c) 2009 Aarne Ranta under LGPL
abstract Foods = {
flags startcat = Comment ;
cat
Comment ; Item ; Kind ; Quality ;
fun
-- Pred : Item -> Quality -> Comment ;
-- This, That, These, Those : Kind -> Item ;
-- Mod : Quality -> Kind -> Kind ;
-- Wine, Cheese, Fish, Pizza : Kind ;
-- Very : Quality -> Quality ;
-- Fresh, Warm, Italian,
-- Expensive, Delicious, Boring : Quality ;
Expensive: Quality;
}

6
testsuite/canonical/grammars/FoodsFin.gf Normal file
View File

@@ -0,0 +1,6 @@
-- (c) 2009 Aarne Ranta under LGPL
concrete FoodsFin of Foods = FoodsI with
(Syntax = SyntaxFin),
(LexFoods = LexFoodsFin) ;

29
testsuite/canonical/grammars/FoodsI.gf Normal file
View File

@@ -0,0 +1,29 @@
-- (c) 2009 Aarne Ranta under LGPL
incomplete concrete FoodsI of Foods =
open Syntax, LexFoods in {
lincat
Comment = Utt ;
Item = NP ;
Kind = CN ;
Quality = AP ;
lin
Pred item quality = mkUtt (mkCl item quality) ;
This kind = mkNP this_Det kind ;
That kind = mkNP that_Det kind ;
These kind = mkNP these_Det kind ;
Those kind = mkNP those_Det kind ;
Mod quality kind = mkCN quality kind ;
Very quality = mkAP very_AdA quality ;
Wine = mkCN wine_N ;
Pizza = mkCN pizza_N ;
Cheese = mkCN cheese_N ;
Fish = mkCN fish_N ;
Fresh = mkAP fresh_A ;
Warm = mkAP warm_A ;
Italian = mkAP italian_A ;
Expensive = mkAP expensive_A ;
Delicious = mkAP delicious_A ;
Boring = mkAP boring_A ;
}

15
testsuite/canonical/grammars/LexFoods.gf Normal file
View File

@@ -0,0 +1,15 @@
-- (c) 2009 Aarne Ranta under LGPL
interface LexFoods = open Syntax in {
oper
wine_N : N ;
pizza_N : N ;
cheese_N : N ;
fish_N : N ;
fresh_A : A ;
warm_A : A ;
italian_A : A ;
expensive_A : A ;
delicious_A : A ;
boring_A : A ;
}

21
testsuite/canonical/grammars/LexFoodsFin.gf Normal file
View File

@@ -0,0 +1,21 @@
-- (c) 2009 Aarne Ranta under LGPL
--# -coding=latin1
instance LexFoodsFin of LexFoods =
open SyntaxFin, ParadigmsFin in {
oper
wine_N = mkN "viini" ;
pizza_N = mkN "pizza" ;
cheese_N = mkN "juusto" ;
fish_N = mkN "kala" ;
fresh_A = mkA "tuore" ;
warm_A = mkA
(mkN "l<>mmin" "l<>mpim<69>n" "l<>mmint<6E>" "l<>mpim<69>n<EFBFBD>" "l<>mpim<69><6D>n"
"l<>mpimin<69>" "l<>mpimi<6D>" "l<>mpimien" "l<>mpimiss<73>" "l<>mpimiin"
)
"l<>mpim<69>mpi" "l<>mpimin" ;
italian_A = mkA "italialainen" ;
expensive_A = mkA "kallis" ;
delicious_A = mkA "herkullinen" ;
boring_A = mkA "tyls<6C>" ;
}

9
testsuite/canonical/grammars/Phrasebook.gf Normal file
View File

@@ -0,0 +1,9 @@
abstract Phrasebook = {
cat PlaceKind ;
fun Airport : PlaceKind ;
cat VerbPhrase ;
fun VRead : VerbPhrase ;
}

31
testsuite/canonical/grammars/PhrasebookBul.gf Normal file
View File

@@ -0,0 +1,31 @@
--# -path=.:present
concrete PhrasebookBul of Phrasebook =
open
SyntaxBul,
(R = ResBul),
ParadigmsBul,
Prelude in {
lincat
PlaceKind = CNPlace ;
oper
CNPlace : Type = {name : CN ; at : Prep ; to : Prep; isPl : Bool} ;
mkPlace : N -> Prep -> {name : CN ; at : Prep ; to : Prep; isPl : Bool} = \n,p ->
mkCNPlace (mkCN n) p to_Prep ;
mkCNPlace : CN -> Prep -> Prep -> CNPlace = \p,i,t -> {
name = p ;
at = i ;
to = t ;
isPl = False
} ;
na_Prep = mkPrep "на" R.Acc ;
lin
Airport = mkPlace (mkN066 "летище") na_Prep ;
}

14
testsuite/canonical/grammars/PhrasebookGer.gf Normal file
View File

@@ -0,0 +1,14 @@
--# -path=.:present
concrete PhrasebookGer of Phrasebook =
open
SyntaxGer,
LexiconGer in {
lincat
VerbPhrase = VP ;
lin
VRead = mkVP <lin V read_V2 : V> ;
}

36
testsuite/canonical/run-on-grammar.sh Executable file
View File

@@ -0,0 +1,36 @@
#!/usr/bin/env sh
# For a given grammar, compile into canonical format,
# then ensure that the canonical format itself is compilable.
if [ $# -lt 1 ]; then
echo "Please specify concrete modules to test with, e.g.:"
echo "./run-on-grammar.sh ../../../gf-contrib/foods/FoodsEng.gf ../../../gf-contrib/foods/FoodsFin.gf"
exit 2
fi
FAILURES=0
for CNC_PATH in "$@"; do
CNC_FILE=$(basename "$CNC_PATH")
stack run -- --batch --output-format=canonical_gf "$CNC_PATH"
if [ $? -ne 0 ]; then
echo "Failed to compile into canonical"
FAILURES=$((FAILURES+1))
continue
fi
stack run -- --batch "canonical/$CNC_FILE"
if [ $? -ne 0 ]; then
echo "Failed to compile canonical"
FAILURES=$((FAILURES+1))
fi
done
# Summary
if [ $FAILURES -ne 0 ]; then
echo "Failures: $FAILURES"
exit 1
else
echo "All tests passed"
fi

54
testsuite/canonical/run.sh Executable file
View File

@@ -0,0 +1,54 @@
#!/usr/bin/env sh
FAILURES=0
# https://github.com/GrammaticalFramework/gf-core/issues/100
stack run -- --batch --output-format=canonical_gf grammars/PhrasebookBul.gf
stack run -- --batch canonical/PhrasebookBul.gf
if [ $? -ne 0 ]; then
echo "Canonical grammar doesn't compile: FAIL"
FAILURES=$((FAILURES+1))
else
# echo "Canonical grammar compiles: OK"
diff canonical/PhrasebookBul.gf gold/PhrasebookBul.gf
if [ $? -ne 0 ]; then
echo "Canonical grammar doesn't match gold version: FAIL"
FAILURES=$((FAILURES+1))
else
echo "Canonical grammar matches gold version: OK"
fi
fi
echo ""
# https://github.com/GrammaticalFramework/gf-core/issues/101
stack run -- --batch --output-format=canonical_gf grammars/PhrasebookGer.gf
diff canonical/PhrasebookGer.gf gold/PhrasebookGer.gf
if [ $? -ne 0 ]; then
echo "Canonical grammar doesn't match gold version: FAIL"
FAILURES=$((FAILURES+1))
else
echo "Canonical grammar matches gold version: OK"
fi
echo ""
# https://github.com/GrammaticalFramework/gf-core/issues/102
stack run -- --batch --output-format=canonical_gf grammars/FoodsFin.gf
diff canonical/FoodsFin.gf gold/FoodsFin.gf
if [ $? -ne 0 ]; then
echo "Canonical grammar doesn't match gold version: FAIL"
FAILURES=$((FAILURES+1))
else
echo "Canonical grammar matches gold version: OK"
fi
echo ""
# Summary
if [ $FAILURES -ne 0 ]; then
echo "Failures: $FAILURES"
exit 1
else
echo "All tests passed"
fi

0
testsuite/compiler/check/cyclic/abs-types/test3.gfs.gold Normal file
View File

48
testsuite/compiler/check/lincat-types/Predef.gf Normal file
View File

@@ -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
} ;

12
testsuite/compiler/check/lincat-types/test.gfs.gold
View File

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

80
testsuite/compiler/check/lins/lins.gfs.gold
View File

@@ -1,39 +1,41 @@
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 ;
cat Int ;
cat Nat ;
cat String ;
fun test : C zero ;
fun zero : Nat ;
}
concrete linsCnc {
productions
C1 -> F2[]
lindefs
C0 -> F0
C1 -> F1
lin
F0 := (S0) [lindef C]
F1 := () [lindef Nat]
F2 := () [zero]
sequences
S0 := {0,0}
categories
C := range [C0 .. C0]
labels ["s"]
Float := range [CFloat .. CFloat]
labels ["s"]
Int := range [CInt .. CInt]
labels ["s"]
Nat := range [C1 .. C1]
labels []
String := range [CString .. CString]
labels ["s"]
__gfVar := range [CVar .. CVar]
labels [""]
printnames
}
abstract lins {
cat C Nat ;
cat Float ;
cat Int ;
cat Nat ;
cat String ;
fun test : C zero ;
fun zero : Nat ;
}
concrete linsCnc {
productions
C1 -> F4[]
lindefs
C0 -> F0[CVar]
C1 -> F2[CVar]
linrefs
CVar -> F1[C0]
CVar -> F3[C1]
lin
F0 := (S2) ['lindef C']
F1 := (S1) ['lindef C']
F2 := () ['lindef Nat']
F3 := (S0) ['lindef Nat']
F4 := () [zero]
sequences
S0 :=
S1 := <0,0>
S2 := {0,0}
categories
C := range [C0 .. C0]
labels ["s"]
Float := range [CFloat .. CFloat]
labels ["s"]
Int := range [CInt .. CInt]
labels ["s"]
Nat := range [C1 .. C1]
labels []
String := range [CString .. CString]
labels ["s"]
printnames
}

7
testsuite/compiler/check/oper-definition/test.gfs.gold
View File

@@ -1,5 +1,6 @@
testsuite/compiler/check/oper-definition/Res.gf:3:
Happened in operation my_oper
No definition given to the operation
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

161
testsuite/compiler/check/strMatch/Prelude.gf Normal file
View File

@@ -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) ;
}

1
testsuite/compiler/check/strMatch/strMatch.gfs.gold Normal file
View File

@@ -0,0 +1 @@

0
testsuite/compiler/params/params.gfs.gold Normal file
View File

15
testsuite/compiler/typecheck/abstract/LetInDefAbs.gfs.gold Normal file
View File

@@ -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

4
testsuite/compiler/typecheck/abstract/LetInTypesAbs.gfs.gold
View File

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

2
testsuite/compiler/typecheck/abstract/LitAbs.gf
View File

@@ -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 ;

1
testsuite/compiler/typecheck/abstract/LitAbs.gfs
View File

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

17
testsuite/compiler/typecheck/abstract/LitAbs.gfs.gold
View File

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

5
testsuite/compiler/typecheck/abstract/non-abstract-terms.gfs
View File

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

7
testsuite/compiler/typecheck/abstract/test_A.gfs.gold
View File

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

7
testsuite/compiler/typecheck/abstract/test_B.gfs.gold
View File

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

7
testsuite/compiler/typecheck/abstract/test_C.gfs.gold
View File

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

10
testsuite/compiler/typecheck/concrete/test_A.gfs.gold
View File

@@ -1,5 +1,9 @@
testsuite/compiler/typecheck/concrete/A.gf:5:
Happened in operation silly
A function type is expected for a_Det instead of type Str
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

226
testsuite/libraries/exx-resource.gfs
View File

@@ -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)))))

1032
testsuite/libraries/exx-resource.gfs.gold
View File

File diff suppressed because it is too large Load Diff

119
testsuite/run.hs
View File

@@ -1,44 +1,35 @@
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)
import System.Exit(exitSuccess,exitFailure)
main =
type TestResult = (FilePath, RunResult)
type RunResult = (String, (String, String, String)) -- (message, (input commands, gold output, actual output))
main :: IO ()
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
if ok<cnt
then do putStrLn $ overview++" contains an overview of the failed tests"
exitFailure
else exitSuccess
-- | Recurse through files in path, running a test for all .gfs files
walk :: FilePath -> IO [TestResult]
walk path = fmap concat . mapM (walkFile . (path </>)) =<< ls path
where
toHTML res =
"<!DOCTYPE html>\n"
++ "<meta charset=\"UTF-8\">\n"
++ "<style>\n"
++ "pre { max-width: 600px; overflow: scroll; }\n"
++ "th,td { vertical-align: top; text-align: left; }\n"
++ "</style>\n"
++ "<table border=1>\n<tr><th>Result<th>Input<th>Gold<th>Output\n"
++ unlines (map testToHTML res)
++ "</table>\n"
testToHTML (in_file,(res,(input,gold,output))) =
"<tr>"++concatMap td [pre res,in_file++":\n"++pre input,pre gold,pre output]
pre s = "<pre>"++s++"</pre>"
td s = "<td>"++s
walk path = fmap concat . mapM (walkFile . (path </>)) =<< ls path
walkFile :: FilePath -> IO [TestResult]
walkFile fpath = do
exists <- doesFileExist fpath
if exists
@@ -53,27 +44,71 @@ main =
else return []
else walk fpath
runTest in_file out_file gold_file = do
input <- readFile in_file
writeFile out_file =<< run_gf 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)
else do out <- compatReadFile out_file
return ("MISSING GOLD",(input,"",out))
-- Avoid failures caused by Win32/Unix text file incompatibility
compatReadFile path =
do h <- openFile path ReadMode
hSetNewlineMode h universalNewlineMode
hGetContents h
-- | Run an individual test
runTest :: FilePath -> FilePath -> FilePath -> IO RunResult
runTest in_file out_file gold_file = do
input <- readFile in_file
writeFile out_file =<< runGF ["-run"] input
exists <- doesFileExist gold_file
if exists
then do out <- compatReadFile out_file
gold <- compatReadFile gold_file
let info = (input,gold,out)
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))
-- | Test scripts which should fail
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
]
-- | Produce HTML document with test results
toHTML :: [TestResult] -> String
toHTML res =
"<!DOCTYPE html>\n"
++ "<meta charset=\"UTF-8\">\n"
++ "<style>\n"
++ "pre { max-width: 600px; overflow: scroll; }\n"
++ "th,td { vertical-align: top; text-align: left; }\n"
++ "</style>\n"
++ "<table border=1>\n<tr><th>Result<th>Input<th>Gold<th>Output\n"
++ unlines (map testToHTML res)
++ "</table>\n"
where
testToHTML (in_file,(res,(input,gold,output))) =
"<tr>"++concatMap td [pre res,in_file++":\n"++pre input,pre gold,pre output]
pre s = "<pre>"++s++"</pre>"
td s = "<td>"++s
-- | Run commands in GF shell, returning output
runGF
:: [String] -- ^ command line flags
-> String -- ^ standard input (shell commands)
-> IO String -- ^ standard output
runGF = readProcess defaultGF
-- Should consult the Cabal configuration!
run_gf = readProcess default_gf ["-run","-gf-lib-path="++gf_lib_path]
default_gf = "dist/build/gf/gf"<.>exeExtension buildPlatform
gf_lib_path = "dist/build/rgl"
defaultGF :: FilePath
defaultGF = "gf"<.>exeExtension
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 :: FilePath -> IO [String]
ls path = filter (`notElem` [".",".."]) `fmap` getDirectoryContents path
-- | Avoid failures caused by Win32/Unix text file incompatibility
compatReadFile :: FilePath -> IO String
compatReadFile path =
do h <- openFile path ReadMode
hSetNewlineMode h universalNewlineMode
hGetContents h

11
testsuite/runtime/linearize/brackets.gfs.gold
View File

@@ -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
cannot linearize

10
testsuite/runtime/linearize/linearize.gfs.gold
View File

@@ -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