diff options
| author | Nicolas Pouillard <np@nicolaspouillard.fr> | 2006-07-17 14:05:28 +0000 |
|---|---|---|
| committer | Nicolas Pouillard <np@nicolaspouillard.fr> | 2006-07-17 14:05:28 +0000 |
| commit | d1d2a3b29485f05e6a00085767b2ca7e9b3e48af (patch) | |
| tree | 524d556aa63439f3e88c1a43b55b91b6cd6f9cb2 /camlp4/test/fixtures | |
| parent | fb1c41d7d426cc42dfe4a2e4da2711d7c7333f6f (diff) | |
More test fixtures
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7507 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'camlp4/test/fixtures')
19 files changed, 212 insertions, 0 deletions
diff --git a/camlp4/test/fixtures/bug-4058.ml b/camlp4/test/fixtures/bug-4058.ml new file mode 100644 index 000000000..f83322bb8 --- /dev/null +++ b/camlp4/test/fixtures/bug-4058.ml @@ -0,0 +1,4 @@ +let _ = (fun x -> x), 1 +let _ = (x := 1), 2 +let _ = (x <- 1), 2 +let _ = (if true then 1 else 2), 1 diff --git a/camlp4/test/fixtures/bug-by-vincent-balat.ml b/camlp4/test/fixtures/bug-by-vincent-balat.ml new file mode 100644 index 000000000..ed75488a4 --- /dev/null +++ b/camlp4/test/fixtures/bug-by-vincent-balat.ml @@ -0,0 +1 @@ +fun a -> x <- !x + 1; x <- !x + 2 diff --git a/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml b/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml new file mode 100644 index 000000000..2de1a43fc --- /dev/null +++ b/camlp4/test/fixtures/bug-camlp4o-benjamin-monate.ml @@ -0,0 +1,2 @@ +type t = A of t | B ;; +let f = function A A B -> B | B | A B | A (A _) -> B ;; diff --git a/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml b/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml new file mode 100644 index 000000000..fc9b6ada0 --- /dev/null +++ b/camlp4/test/fixtures/bug-camlp4o-constr-arity-expr.ml @@ -0,0 +1,8 @@ +(* Some Some Some None;; *) +(* ((Some None) None) None;; *) +((Some) None);; +(* ((Some Some) Some) None;; *) +type t = A of int * int * int;; +A (1, 2, 3);; +(A) (1, 2, 3);; +(A (1, 2)) 3;; diff --git a/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml b/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml new file mode 100644 index 000000000..707bb2c02 --- /dev/null +++ b/camlp4/test/fixtures/bug-camlp4o-constr-arity.ml @@ -0,0 +1,10 @@ +function +| Some Some Some x -> x +(* | None None None x -> x *) +| _ -> assert false;; + +fun None None None -> ();; + +fun (Some None) None None -> ();; + +fun Some None None None -> ();; diff --git a/camlp4/test/fixtures/free_vars_test.ml b/camlp4/test/fixtures/free_vars_test.ml new file mode 100644 index 000000000..813927b58 --- /dev/null +++ b/camlp4/test/fixtures/free_vars_test.ml @@ -0,0 +1,72 @@ +open Format; +open Camlp4.PreCast; + +module FV = Camlp4.Struct.FreeVars.Make Ast; + +#default_quotation "expr"; + +e e%%e + +value print_set f s = do { + fprintf f "@[<2>{ "; + FV.S.iter (fprintf f "%s@ ") s; + fprintf f "}@]"; +}; + +module PP = Camlp4.Printers.OCamlr.Make Syntax; +value print_expr = (new PP.printer ())#expr; + +value print_status f st = pp_print_string f (if st then "PASS" else "FAIL"); + +value _loc = Loc.ghost; + +value atoms e = + let o = object + inherit Ast.fold as super; + value accu = FV.S.empty; + method accu = accu; + method expr = + fun + [ << $lid:s$ >> -> {< accu = FV.S.add s accu >} + | e -> super#expr e ]; + end in (o#expr e)#accu; + +value fv e ref = + let s = FV.free_vars FV.S.empty e in + let ref = atoms ref in + let st = FV.S.equal s ref in do { + printf "%a: @[<hv0>fv << %a >> = %a" + print_status st + print_expr e print_set s; + if st then () else printf "@ ref = %a@ diff = %a" + print_set ref print_set (FV.S.diff ref s); + printf "@]@ "; +}; + +printf "@[<v0>"; + +fv << x >> << x >>; +fv << x y >> << x y >>; +fv << fun x -> x y >> << y >>; +fv << fun y -> fun x -> x y >> <<>>; +fv << let x = 42 and y = 44 in x y z >> << z >>; +fv << let z = g in let x = 42 and y = 44 in x y z >> << g >>; +fv << let rec f x = g (x + 1) and g y = f (y - 1) in fun x -> g x * f x >> << \+ \- \* >>; +fv << let rec f x = g (x + 1) and g y = f (g (y - 1)) in fun x -> g x * f x >> << \+ \- \* >>; + +fv << let i = 42 in let module M = struct value f x = y x; end in M.h >> << y >>; + +fv << fun [ A x -> x y ] >> << y >>; + +fv << fun [ A x -> x y | _ -> x ] >> << x y >>; + +fv << fun [ { x = A z; y = y } as q -> x z y a q ] >> << x a >>; + +fv << let module M = struct value a = 42; value b = a + 1; end in () >> <<\+>>; + +fv << let module M = struct value rec a = 42; value b = a + 1; end in () >> <<\+>>; + +fv << let rec f x = x and g = x in y >> << x y >>; +fv << let f x = x in x >> << x >>; + +printf "@]@.";
\ No newline at end of file diff --git a/camlp4/test/fixtures/gram-fold.cmi b/camlp4/test/fixtures/gram-fold.cmi Binary files differnew file mode 100644 index 000000000..62d273bb9 --- /dev/null +++ b/camlp4/test/fixtures/gram-fold.cmi diff --git a/camlp4/test/fixtures/gram-fold.cmo b/camlp4/test/fixtures/gram-fold.cmo Binary files differnew file mode 100644 index 000000000..42be5664a --- /dev/null +++ b/camlp4/test/fixtures/gram-fold.cmo diff --git a/camlp4/test/fixtures/lambda_free.ml b/camlp4/test/fixtures/lambda_free.ml new file mode 100644 index 000000000..4d6f13510 --- /dev/null +++ b/camlp4/test/fixtures/lambda_free.ml @@ -0,0 +1,68 @@ +open Format; + +module S = Set.Make String; + +type term = + [ Lambda of string and term + | Atom of string + | App of term and term + | Opt of term and option term and term + ]; + +value free_vars = + let rec fv t env free = + match t with + [ Lambda x t -> fv t (S.add x env) free + | Atom x -> if S.mem x env then free else S.add x free + | App t1 t2 -> fv t1 env (fv t2 env free) + | Opt _ _ _ -> assert False ] + in fun t -> fv t S.empty S.empty; + +value print_set f s = do { + fprintf f "@[<2>{ "; + S.iter (fprintf f "%s@ ") s; + fprintf f "}@]"; +}; + +value t1 = Lambda "x" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "x" (Atom "x"))); +value t2 = Lambda "x" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "z" (Atom "z"))); +value t3 = Lambda "x" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "x" (Atom "z"))); +value t4 = Lambda "a" (App (Lambda "y" (App (Atom "y") (Atom "x"))) (Lambda "x" (Atom "z"))); + +printf "t1: %a@." print_set (free_vars t1); +printf "t2: %a@." print_set (free_vars t2); +printf "t3: %a@." print_set (free_vars t3); +printf "t4: %a@." print_set (free_vars t4); + +class fold ['accu] init = + object (o : 'self_type) + value accu : 'accu = init; + method accu = accu; + method term t = + match t with + [ Lambda x t -> (o#string x)#term t + | Atom x -> o#string x + | App t1 t2 -> (o#term t1)#term t2 + | Opt t1 ot t2 -> ((o#term t1)#option (fun o -> o#term) ot)#term t2 ]; + method string : string -> 'self_type = fun _ -> o; + method option : ! 'a. ('self_type -> 'a -> 'self_type) -> option 'a -> 'self_type = + fun f opt -> + match opt with + [ None -> o + | Some x -> f o x ]; + end; + +class fold_atoms ['accu] f init = + object (o : 'self_type) + inherit fold ['accu] init as super; + method term t = + match t with + [ Atom x -> {< accu = f x accu >} + | _ -> super#term t ]; + end; + +value t5 = Opt (Atom "a") (Some (Atom "b")) (Atom "c"); + +value atoms = ((new fold_atoms S.add S.empty)#term t5)#accu; + +printf "atoms: %a@." print_set atoms; diff --git a/camlp4/test/fixtures/pp_let_in.cmi b/camlp4/test/fixtures/pp_let_in.cmi Binary files differnew file mode 100644 index 000000000..1cd04189b --- /dev/null +++ b/camlp4/test/fixtures/pp_let_in.cmi diff --git a/camlp4/test/fixtures/pp_let_in.cmo b/camlp4/test/fixtures/pp_let_in.cmo Binary files differnew file mode 100644 index 000000000..f4634afb3 --- /dev/null +++ b/camlp4/test/fixtures/pp_let_in.cmo diff --git a/camlp4/test/fixtures/pp_let_in.ml b/camlp4/test/fixtures/pp_let_in.ml new file mode 100644 index 000000000..c6162499b --- /dev/null +++ b/camlp4/test/fixtures/pp_let_in.ml @@ -0,0 +1,10 @@ +let i = "toto" in do { (let i = 42 in print_int i); print_string i }; +let i = "toto" in do { print_string i; let i = 42 in print_int i; print_int i }; +let i = "toto" in do { + (let i = 42 in print_int i); + let i = i ^ i; + let i = i ^ i; + print_string i; + print_string i; + let i = i ^ i; + print_string i }; diff --git a/camlp4/test/fixtures/pp_let_in2.ml b/camlp4/test/fixtures/pp_let_in2.ml new file mode 100644 index 000000000..7e9b3496e --- /dev/null +++ b/camlp4/test/fixtures/pp_let_in2.ml @@ -0,0 +1 @@ +let i = "toto" in ((let i = 42 in print_int i); print_string i) diff --git a/camlp4/test/fixtures/pp_xml.cmi b/camlp4/test/fixtures/pp_xml.cmi Binary files differnew file mode 100644 index 000000000..76eba890b --- /dev/null +++ b/camlp4/test/fixtures/pp_xml.cmi diff --git a/camlp4/test/fixtures/pp_xml.cmo b/camlp4/test/fixtures/pp_xml.cmo Binary files differnew file mode 100644 index 000000000..893d7e850 --- /dev/null +++ b/camlp4/test/fixtures/pp_xml.cmo diff --git a/camlp4/test/fixtures/pp_xml.ml b/camlp4/test/fixtures/pp_xml.ml new file mode 100644 index 000000000..986998c41 --- /dev/null +++ b/camlp4/test/fixtures/pp_xml.ml @@ -0,0 +1,31 @@ + +type xml = Elt of string * xml list | Pcdata of string + +let pp = Format.fprintf + +let rec print_elt f = + function + | Elt (tag, contents) -> + pp f "@[<hv0>@[<hv2><%s>@,%a@]@,</%s>@]" + tag print_list_elts contents tag + | Pcdata s -> + Format.pp_print_string f s + +and print_list_elts f = + let rec loop = + function + | [] -> () + | x::xs -> (pp f "@,"; print_elt f x; loop xs) in + function + | [] -> () + | [x] -> print_elt f x + | x::xs -> (print_elt f x; loop xs) + +let tree = + Elt ("div", [ + Elt ("p", [Pcdata "a short text"]); + Elt ("p", [Pcdata "a looooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooong text"]) + ]) + +let () = Format.printf "%a@." print_elt tree + diff --git a/camlp4/test/fixtures/transform-examples.ml b/camlp4/test/fixtures/transform-examples.ml new file mode 100644 index 000000000..0aea9c4d6 --- /dev/null +++ b/camlp4/test/fixtures/transform-examples.ml @@ -0,0 +1,3 @@ +<:expr< $x$ + $y$ - $z$ >> -> <:expr< plus_minus $x$ $y$ $z$ >> + +<< List.rev (List.rev $l$) >> -> l diff --git a/camlp4/test/fixtures/where.o.ml b/camlp4/test/fixtures/where.o.ml new file mode 100644 index 000000000..8295d4a26 --- /dev/null +++ b/camlp4/test/fixtures/where.o.ml @@ -0,0 +1 @@ +let where = 42 diff --git a/camlp4/test/fixtures/where.r.ml b/camlp4/test/fixtures/where.r.ml new file mode 100644 index 000000000..e48c30853 --- /dev/null +++ b/camlp4/test/fixtures/where.r.ml @@ -0,0 +1 @@ +x where x = 42; |