Commit 71ddc3a0 authored by Kim Nguyễn's avatar Kim Nguyễn

Remove all the unneeded and untested cruft.

parent 3a94a2d7
#directory "_build";;
#use "topfind";;
#require "num";;
#load "cduce_boolvar.cma";;
#camlp4o;;
#require "camlp4.extend";;
#require "ulex";;
#require "pcre";;
#require "netstring";;
#load "typesOUnit.cma";;
open TypesOUnit;;
open Types;;
let parse_typ s =
let st = Stream.of_string s in
let astpat = Parser.pat st in
let nodepat = Typer.typ Builtin.env astpat in
Types.descr nodepat
;;
type pp = P of vv * string | N of string * vv
and vv = V of string
let mk_pp = function
|P(V alpha,t) -> Tallying.CS.singleton (Tallying.Pos (Var.mk alpha,parse_typ t))
|N(t,V alpha) -> Tallying.CS.singleton (Tallying.Neg (parse_typ t,Var.mk alpha))
let mk_prod l =
List.fold_left (fun acc2 c ->
Tallying.CS.prod Var.Set.empty (mk_pp c) acc2
) Tallying.CS.sat l
let mk_union l1 l2 =
Tallying.CS.union (mk_prod l1) (mk_prod l2)
let mk_s ll =
List.fold_left (fun acc1 l ->
Tallying.CS.union (mk_prod l) acc1
) Tallying.CS.S.empty ll
module BIN = struct
open Builtin_defs
(* Types *)
let stringn = Types.cons string
let namespaces =
Sequence.star (Types.times stringn stringn)
let types =
[
"Empty", Types.empty;
"Any", any;
"Int", int;
"Char", Types.char Chars.any;
"Byte", char_latin1;
"Atom", atom;
"Pair", Types.Product.any;
"Arrow", Types.Arrow.any;
"Record", Types.Record.any;
"String", string;
"Latin1", string_latin1;
"Bool", bool;
"Float", float;
"AnyXml", any_xml;
"Namespaces", namespaces;
"Caml_int", caml_int;
]
let env =
List.fold_left
(fun accu (n,t) ->
let n = (Ns.empty, Ident.U.mk n) in
Types.Print.register_global "" n t;
Typer.enter_type (Ident.ident n) t accu
)
Typer.empty_env
types
end
let parse_expr s =
let astexpr = Parser.expr (Stream.of_string s) in
let texpr = fst (Typer.type_expr BIN.env astexpr) in
texpr
;;
......@@ -49,26 +49,7 @@ package: clean
git archive --prefix=$(PACKAGE)/ -o $(PACKAGE).tar.gz HEAD
OCAML_STDLIBDIR := $(shell ocamlc -where)
.PHONY: .ocamlinit
.ocamlinit:
echo '(* AUTOMATICALLY GENERATED by Makefile: DO NOT EDIT! *)' > $@
echo '#load "$(OCAML_STDLIBDIR)/pcre/pcre.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/unix.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/netstring/netstring.cma";;' >> $@
# echo '#load "$(OCAML_STDLIBDIR)/netstring/netstring_top.cmo";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/pxp-engine/pxp_engine.cma";;' >> $@
# echo '#load "$(OCAML_STDLIBDIR)/pxp-engine/pxp_top.cmo";;' *)' >> $@
echo '#load "$(OCAML_STDLIBDIR)/pxp-lex-iso88591/pxp_lex_iso88591.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/pxp-lex-iso88591/pxp_lex_link_iso88591.cmo";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/ulex/ulexing.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/nums.cma";;' >> $@
# echo '#load "$(OCAML_STDLIBDIR)/num_top.cma";;' >> $@
echo '#load "$(OCAML_STDLIBDIR)/cgi/cgi.cma";;' >> $@
for o in $(VALIDATE_OBJECTS); do echo "prerr_endline \"Loading $$o ...\";;" >> $@; echo "#load \"$$o\";;" >> $@; done
for d in $(DIRS); do echo "#directory \"$$d\";;" >> $@; done
for p in pcre netstring pxp-engine ulex cgi; do echo "#directory \"`$(OCAMLFIND) query $$p`\";;" >> $@; done
echo "prerr_endline \"All done!\"" >> $@
echo '(* vim: set ft=ocaml: *)' >> $@
.PHONY:
CVS_DISTRIB = web CHANGES LICENSE README AUTHORS cduce dtd2cduce
CVS_DOC = doc/cdo2ml.1 doc/cduce.1 doc/cduce_mktop.1 doc/cduce_validate.1 doc/dtd2cduce.1 doc/fomanual/tutorial.pdf doc/fomanual/manual.pdf
......@@ -119,7 +100,3 @@ evaluator: $(EVALUATOR:.cmo=.$(EXTENSION))
# (to compile it on a machine which is not the web server)
# Seems to be some problems with statically linking curl
# EXTRA_OPTS_WEBIFACE += -ccopt -static
typestop:
ocamlbuild typesOUnit.cma
ocaml -init tests/toplevel/typesOUnit.ocamlinit
DIRS= cduce/misc cduce/types cduce/compile cduce/runtime
ML_SRC= \
cduce/misc/serialize.ml \
cduce/misc/custom.ml \
cduce/misc/encodings.ml \
cduce/misc/imap.ml \
cduce/misc/state.ml \
cduce/misc/pool.ml \
cduce/misc/ns.ml \
cduce/types/sortedList.ml \
cduce/types/atoms.ml \
cduce/misc/bool.ml \
cduce/types/chars.ml \
cduce/types/var.ml \
cduce/types/boolVar.ml \
cduce/types/ident.ml \
cduce/types/intervals.ml \
cduce/misc/inttbl.ml \
cduce/types/normal.ml \
cduce/misc/pretty.ml \
cduce/misc/stats.ml \
cduce/types/types.ml \
cduce/types/sequence.ml \
cduce/types/sample.ml \
cduce/types/patterns.ml \
cduce/compile/lambda.ml \
cduce/runtime/value.ml \
cduce/runtime/run_dispatch.ml \
cduce/runtime/explain.ml \
cduce/runtime/serial.ml
CMO_OBJECTS=$(ML_SRC:.ml=.cmo)
CMX_OBJECTS=$(ML_SRC:.ml=.cmx)
$(CMO_OBJECTS) $(CMX_OBJECTS): $(COMPILER)
$(CMX_OBJECTS): $(OPTCOMPILER)
cduce_types.cmo: $(CMO_OBJECTS)
$(CAMLC) $(COMPFLAGS) -pack -o cduce_types.cmo $(CDUCE_INCLUDES) $(CMO_OBJECTS)
cduce_types.cmx: $(CMX_OBJECTS)
$(CAMLOPT) $(OPTCOMPFLAGS) -pack -o cduce_types.cmx $(CDUCE_INCLUDES) $(CMX_OBJECTS)
cduce_types.p.cmx: cduce_types.cmx
cp cduce_types.cmx cduce_types.p.cmx
cp cduce_types.o cduce_types.p.o
CDUCE_INCLUDES = $(DIRS:%=-I %)
.SUFFIXES: .ml .mli .cmo .cmi .cmx
.ml.cmo:
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) $<
.ml.cmx:
$(CAMLOPT) $(OPTCOMPFLAGS) -c $(CDUCE_INCLUDES) $<
.mli.cmi:
$(CAMLC) $(COMPFLAGS) -c $(CDUCE_INCLUDES) $<
.PHONY: compute_depend
compute_depend:
ocamldep $(CDUCE_INCLUDES) $(SRC) $(SRC:.ml=.mli) > cduce/types_depend
include cduce/types_depend
clean:
for i in $(DIRS); do \
(cd $$i; rm -f *.cmi *.cmo *.cma *.cmx *.o *.a *.cmxa *~); \
done
true: -traverse
<{misc,types}/**>: traverse
<misc>: include
<types>: include
<parser>: include
<typing>: include
<compile>: include
<schema>: include
<runtime>: include
<{misc,types,typing,schema,compile,runtime,parser}/*.cmx>: for-pack(TypesOUnit)
<{misc,types}/*.cmx>: for-pack(BoolVarOUnit)
<parser/**>: package(ulex), package(netstring), package(camlp4.extend), syntax(camlp4o)
<schema/**>: package(pcre), package(netstring)
<runtime/**>: package(pcre), package(netstring)
<tests/libtest/*Test.*>: package(netstring), package(pcre), package(oUnit), package(ulex), package(num), package(camlp4.lib)
Upool
Serialize
Custom
Encodings
Imap
State
Pool
Ns
SortedList
Var
Atoms
Bool
Chars
Ident
Intervals
Inttbl
Normal
Pretty
Stats
BoolVar
open Ocamlbuild_plugin;;
Options.use_ocamlfind := true ;;
open Command ;;
(*
let _ = dispatch begin function
| After_rules ->
ocaml_lib ~extern:true ~dir:"_build" "typesOUnit"
| _ -> ()
end;;
*)
#!/bin/sh
# Do not change these variables directly. Use options to modify the behavior of
# the script (see usage).
VERBOSE="false"
WITHOCAML="false"
OCAMLFOLDER="ocaml"
PACKAGES="pcre-ocaml ocamlnet pxp ocurl ocaml-expat ocamlsdl ounit"
usage ()
{
echo "Usage: $0 [OPTION]... [MLVERSION]"
echo "Configures opam for the compilation of CDuce."
echo "Switches the OCaml version of opam if MLVERSION is provided."
echo "Example: $0 --verbose --mliface=ocaml 4.01.0"
echo "Valid options are:"
echo -e "\t-v, --verbose\tactivate verbose mode"
echo -e "\t--mliface=DIR\tcheckout the OCaml sources in DIR to MLVERSION"
echo -e "\t-h, --help\tdisplay this help and exit"
}
# Parse options
while test $# -ge 1; do
if test $1 = "-v" || test $1 = "--verbose"; then VERBOSE="true";
elif echo $1 | grep -qse "--mliface=.*"; then
WITHOCAML="true"; OCAMLFOLDER=`echo $1 | cut -d '=' -f 2`;
elif test $1 = "-h" || test $1 = "--help"; then usage; exit 0;
elif echo $1 | grep -qse "-.*"; then usage; exit 1;
else break; fi;
shift;
done
# Switching opam's version of OCaml
if test $# -ge 1; then
echo -n "Switching to version $1 of OCaml..."
opam switch $1 > /dev/null 2>&1
if test $? -ne 0; then
echo "failed. This version doesn't seem to exist."; exit 2;
fi
echo "done."
echo "# To complete the configuration of OPAM, you need to run:"
echo "eval \`opam config env\`"
fi
# Installing packages
echo "Installing mandatory packages to compile CDuce."
for i in $PACKAGES; do opam install $i; done
# Checkout git repository of OCaml sources to appropriate version.
if test $WITHOCAML = "true" && test $# -ge 1; then
if test -d $OCAMLFOLDER; then
cd $OCAMLFOLDER; git checkout $1 > /dev/null 2>&1
echo "OCaml sources updated to version $1."
else
echo "Couldn't find $OCAMLFOLDER. The interface will not be built."
fi
fi
COMPILER ?= ocamlbuild
ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
LIBFLAGS ?= -libs nums,pcre,netstring -lflags -I,`ocamlfind query pcre`\
-lflags -I,`ocamlfind query netstring`
DEBUGFLAGS ?= -cflags -g -lflags -g
INEXTFILES = misc/custom.ml misc/encodings.ml types/ident.ml\
compile/lambda.ml misc/ns.ml misc/ns.mli misc/upool.ml misc/upool.mli\
types/sortedList.ml types/sortedList.mli types/compunit.ml types/compunit.mli\
types/types.mli types/types.ml runtime/eval.mli runtime/eval.ml\
types/boolVar.ml types/var.ml types/atoms.ml misc/imap.ml types/intervals.ml\
types/chars.ml misc/bool.ml compile/auto_pat.ml runtime/value.ml\
types/sequence.ml schema/schema_validator.ml schema/schema_pcre.ml\
schema/schema_common.ml schema/schema_common.mli schema/schema_types.ml\
schema/schema_xml.ml schema/schema_xml.mli schema/schema_builtin.ml\
types/builtin_defs.ml runtime/run_dispatch.ml runtime/explain.ml\
misc/stats.mli misc/stats.ml types/normal.mli types/normal.ml misc/pretty.ml\
misc/pretty.mli
EXTFILES = $(INEXTFILES:%=$(ROOTDIR)/%)
RM ?= rm -f
OUT ?= main.native
OUTDEBUG ?= main.byte
.PHONY: clean check test _import
all: _import
$(COMPILER) -use-ocamlfind $(LIBFLAGS) $(OUT)
debug: _import
$(COMPILER) -use-ocamlfind $(DEBUGFLAGS) $(LIBFLAGS) $(OUTDEBUG)
_import:
@echo -n "Copying external files..."
@test -d $(EXTDIR) || mkdir $(EXTDIR)
@cp $(EXTFILES) $(EXTDIR)
@echo "done"
clean:
$(COMPILER) -clean
test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)
check: test
test: all
tests/test.sh
<src>: include
<src/compile*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/main*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2, unix, netsys, str)
COMPILER ?= ocamlbuild
ROOTDIR ?= ../..
SRCDIR ?= src
EXTDIR ?= $(SRCDIR)/externals
INEXTFILES = misc/utils.ml misc/custom.ml misc/encodings.ml misc/upool.ml misc/ns.ml\
types/sortedList.ml types/ident.ml misc/html.ml types/sequence.ml\
types/patterns.ml parser/cduce_loc.mli parser/cduce_loc.ml typing/typed.ml\
types/builtin_defs.ml parser/ast.ml parser/parser.ml parser/ulexer.ml typing/typepat.mli typing/typepat.ml\
types/externals.mli types/externals.ml typing/typer.ml\
runtime/run_dispatch.ml runtime/explain.ml schema/schema_pcre.ml\
schema/schema_xml.mli schema/schema_xml.ml schema/schema_common.mli\
schema/schema_common.ml runtime/eval.mli runtime/eval.ml\
compile/compile.ml types/compunit.mli types/compunit.ml types/var.ml\
types/boolVar.ml misc/imap.ml types/atoms.ml types/intervals.ml\
types/chars.mli types/chars.ml misc/bool.mli misc/bool.ml types/types.mli types/sample.ml\
misc/stats.mli misc/stats.ml types/normal.mli types/normal.ml misc/pretty.mli\
misc/pretty.ml types/types.ml compile/auto_pat.mli runtime/value.mli\
runtime/value.ml schema/schema_types.mli schema/schema_validator.mli\
schema/schema_builtin.mli schema/schema_builtin.ml schema/schema_validator.ml\
compile/lambda.ml
EXTFILES = $(INEXTFILES:%=$(ROOTDIR)/%)
RM ?= rm -f
OUT ?= valueTests.native lambdaTests.native typedTests.native astprinter.native
OUTDEBUG ?= valueTests.byte lambdaTests.byte typedTests.byte astprinter.byte
.PHONY: clean _import tests
all: $(OUT)
debug: $(OUTDEBUG)
%.native: _import
$(COMPILER) -use-ocamlfind $@
%.byte: _import
$(COMPILER) -use-ocamlfind -tag debug $@
# Shortcuts
ast: astprinter.native
lambda: lambdaTests.native
typed: typedTests.native
value: valueTests.native
tests:
make -C tests
_import:
@echo -n "Copying external files..."
@test -d $(EXTDIR) || mkdir $(EXTDIR)
@cp $(EXTFILES) $(EXTDIR)
@echo "done"
clean:
make -C tests clean
$(COMPILER) -clean
test $(EXTDIR) = "src" || test $(EXTDIR) = "." || $(RM) -r $(EXTDIR)
true: debug
<src>: include
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/testlib*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str)
<src/*Tests*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str, oUnit, pcre, ulex, num, netstring)
<src/astprinter*>: pp(camlp4orf.opt), package(camlp4.lib, unix, netsys, str, oUnit, pcre, ulex, num, netstring)
<src/externals>: include
<src/externals/schema_*>: package(pcre, netcgi2)
<src/externals/cduce_loc*>: package(ulex), syntax(camlp4o)
<src/externals/{ulexer,parser}.*>: syntax(camlp4o), package(ulex)
This diff is collapsed.
open OUnit2
open Testlib
let run_test_typer msg expected totest _ =
let expected = parse_texpr expected in
let totest = parse_cduce totest in
assert_equal ~msg:msg ~printer:(fun x -> Typed.Print.string_of_typed x) expected totest
let run_test_compile msg expected totest _ =
let expected,_ = parse_texpr_lexpr expected in
let totest,_ = parse_cduce_lexpr totest in
assert_equal ~msg:msg ~printer:(fun x -> Lambda.Print.string_of_lambda x) expected totest
(* (message, typed expr - expected, cduce expr) *)
let tests_typer_list = [
(*
"Test CDuce.typed.fun.const",
"fun f x : Int : Int -> x",
"fun f (Int -> Int) x&Int -> x";
"Test CDuce.typed.fun.identity",
"fun f x : 'A : 'A -> x",
"fun f ('A -> 'A) x -> x";
"Test CDuce.typed.fun.identity.int",
"fun f x : 'A : 'A -> 2",
"fun f ('A -> 'A) x -> x";
"Test CDuce.typed.fun.match",
"fun f x : ('A | Int) : ('A | Int) -> x",
"fun f ('A -> 'A) x & Int -> x | x -> x";
"Test CDuce.typed.fun.partial 1",
"fun f x : 'A : 'A -> 2",
"fun f ( 'A -> 'A -> 'A) x -> fun g -> g x";
"Test CDuce.typed.fun.partial 2",
"fun f x : 'A : 'A -> 2",
"fun f ( g : 'A -> 'B ) ( x : 'A) : 'B = g x";
*)
"Test CDuce.typed.fun.partial 2",
"fun f x : 'A : 'A -> 2",
"let id ( y : 'A ) : 'A = y in id";
]
let tests_typer = "CDuce type tests (Ast -> Typed)" >:::
List.map (fun (msg,expected,cduce) ->
msg >:: run_test_typer msg expected cduce
) tests_typer_list
let tests_compile = "CDuce compile tests (Ast -> Typed -> Lambda)" >:::
List.map (fun (msg,expected,cduce) ->
msg >:: run_test_compile msg expected cduce
) tests_typer_list
let _ =
run_test_tt_main (
test_list
[
tests_typer;
(* tests_compile; *)
]
)
;;
open OUnit2
open Testlib
(* Typed -> Lambda *)
let run_test_compile msg expected totest _ =
let expected,_ = parse_texpr_lexpr ~quite:true expected in
let totest,_ = parse_cduce_lexpr ~quite:true totest in
assert_equal
~msg:msg
~printer:(fun x -> x)
(Lambda.Print.string_of_lambda expected)
(Lambda.Print.string_of_lambda totest)
;;
let tests_poly_abstr = [
"Test CDuce.lambda.let",
"3",
"let x : Int = 3 in x : Int";
"Test CDuce.lambda.appl_identity_int",
"2",
"(fun (x : 'A) : 'A = x) 2";
"Test CDuce.lambda.appl_identity_tag",
"Atom(a)",
"(fun (x : 'A) : 'A = x) `a";
"Test CDuce.lambda.partial",
"Abstraction([('A,Int -> Int)],Id)",
"fun ('A -> (Int -> Int)) | _ -> (fun ('B -> 'B) y -> y)";
"Test CDuce.lambda.appl_partial",
"Abstraction([('B,'B)],Sel(1,[('B -> 'B)],{{'B = Int
}}))",
"(fun ('A -> (Int -> Int)) | _ -> (fun ('B -> 'B) y -> y)) 3";
];;
let tests_compile = "CDuce compile tests (Typed -> Lambda )" >:::
List.map (fun (m,e,f) -> f >:: run_test_compile m e f) tests_poly_abstr
(* Typed -> Lambda -> Value *)
let run_test_eval msg expected totest _ =
let totest = parse_cduce_vexpr ~quite:true totest in
assert_equal
~msg:msg
~printer:(fun x -> x)
expected
(Value.Print.string_of_value totest)
let tests_eval = "CDuce evaluation tests (Typed -> Lambda -> Value )" >:::
List.map (fun (m,e,f) -> f >:: run_test_eval m e f) tests_poly_abstr
let _ =
run_test_tt_main (
test_list
[ (* tests_compile; *)
tests_eval
]
)
;;
COMPILER ?= ocamlbuild
SRCDIR ?= src
RM ?= rm -f
OUT ?= gen_test.native
OUTDEBUG ?= gen_test.byte
.PHONY: clean
all:
$(COMPILER) -use-ocamlfind $(OUT)
debug:
$(COMPILER) -use-ocamlfind -tag debug $(OUTDEBUG)
clean:
$(COMPILER) -clean
<src>: include
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/gen_test*>: pp(camlp4orf.opt), package(camlp4.lib)
This diff is collapsed.
This diff is collapsed.
open OUnit
module type S = sig
include BoolVar.S
val mk_var : string -> t
val mk_atm : string -> t
val to_string : t -> string
end
let to_string pp t =
Format.fprintf Format.str_formatter "%a@." pp t;
Printf.sprintf "->%s<-" (Format.flush_str_formatter ())
module BoolAtoms : S with type s = Atoms.t = struct
include BoolVar.Make(Atoms)
let mk_var s = atom (Var.mk s)
let mk_atm s = atom (`Atm (Atoms.atom (Atoms.V.mk_ascii s)))
let to_string = to_string pp_print
end
(*
module BoolChars : S with type s = Chars.t = struct
include BoolVar.Make(Chars)
let mk_var s = atom (`Var s)
let mk_atm c = atom (`Atm (Chars.atom (Chars.V.mk_char c.[0] )))
let to_string = to_string pp_print
end
module BoolIntervals : S with type s = Intervals.t = struct
include BoolVar.Make(Intervals)
let mk_var s = atom (`Var s)
let mk_atm s = atom (`Atm (Intervals.atom (Intervals.V.mk s)))
let to_string = to_string pp_print
end
*)
module ExprParser (B : S) = struct
open Camlp4.PreCast
let expression = Gram.Entry.mk "expression"
EXTEND Gram
GLOBAL: expression;
expression:
[ "cap" LEFTA
[ x = SELF; "^"; y = SELF -> B.cap x y ]
| "cup" LEFTA
[ x = SELF; "v"; y = SELF -> B.cup x y
| x = SELF; "-"; y = SELF -> B.diff x y ]
| "neg" RIGHTA
[ "~"; x = SELF-> B.diff B.full x ]
| "simple" NONA
["Any" -> B.full
|"Empty" -> B.empty
|"atm"; x = LIDENT -> B.mk_atm x
|"var"; x = LIDENT -> B.mk_var x
|"("; x = SELF; ")" -> x ]
];
END
;;
let of_string s = Gram.parse_string expression Loc.ghost s
let os = of_string
end
module BAP = ExprParser(BoolAtoms)
(*
module BCP = ExprParser(BoolChars)
module BIP = ExprParser(BoolIntervals)
*)
let atoms_tests = [
"commutativity intersection", BAP.os "atm foo ^ atm bar", BAP.os "atm bar ^ atm foo";
"commutativity union", BAP.os "atm foo v atm bar", BAP.os "atm bar v atm foo";
"distributive intersection", BAP.os "(atm foo v atm bar) ^ atm baz", BAP.os "(atm foo ^ atm baz) v (atm bar ^ atm baz)";
"distributive intersection var", BAP.os "(var alpha v atm bar) ^ atm baz", BAP.os "(var alpha ^ atm baz) v (atm bar ^ atm baz)";
"associativity intersection", BAP.os "(atm foo ^ atm bar) ^ atm baz", BAP.os "atm foo ^ (atm bar ^ atm baz)";
"associativity intersection var", BAP.os "(atm foo ^ atm bar) ^ var alpha", BAP.os "atm foo ^ (atm bar ^ var alpha)";
"associativity union", BAP.os "(atm foo v atm bar) v atm baz", BAP.os "atm foo v (atm bar v atm baz)";
"associativity union var", BAP.os "(atm foo v var alpha) v atm baz", BAP.os "atm foo v (var alpha v atm baz)";
"intersection", BAP.os "(atm foo ^ atm bar) v var alpha", BAP.os "var alpha";
"intersection 2", BAP.os "(atm foo v var alpha ) ^ var alpha", BAP.os "var alpha";
"intersection empty", BAP.os "atm foo ^ atm bar", BAP.os "Empty";
"difference", BAP.os "(atm foo v var alpha) - (var alpha)", BAP.os "atm foo ^ ~ var alpha";
"difference", BAP.os "(atm foo v var alpha) - (atm foo)", BAP.os "var alpha ^ ~ atm foo";
"difference any 1", BAP.os "~ var alpha", BAP.os "Any - var alpha";
"difference any 2", BAP.os "~ var alpha", BAP.os "Any ^ ~ var alpha";
];;
let atoms_structure =
"atoms structure" >:::
List.map (fun (descr, result,expected) ->
(Printf.sprintf "test %s" descr) >:: (fun _ ->
assert_equal ~cmp:BoolAtoms.equal ~printer:(BoolAtoms.to_string) expected result
)
) atoms_tests
;;
let atoms_contains =
"atoms contains" >:::
List.map (fun (descr, i, s) ->
(Printf.sprintf "test %s" descr) >:: (fun _ ->
let a = Atoms.V.mk_ascii i in
let t = BAP.os s in
assert_equal (Atoms.contains a (BoolAtoms.leafconj t)) true
)
)
[
"foo in atm foo","foo","atm foo";
"foo in (atm foo v atm bar)","foo","atm foo v atm bar";
"foo in (atm foo v atm bar) ^ ^ var beta","foo","(atm foo v atm bar) ^ var beta";
]
;;
let all =
"all tests" >::: [
atoms_structure;
atoms_contains;
]
let main () =
OUnit.run_test_tt_main all
;;
main ();;
open OUnit
open Types
let parse_typ s =
let st = Stream.of_string s in
let astpat = Parser.pat st in
let nodepat =