[Toss-devel-svn] SF.net SVN: toss:[1680] trunk/Toss

[<luk...@us...>]

Revision: 1680
          http://toss.svn.sourceforge.net/toss/?rev=1680&view=rev
Author:   lukaszkaiser
Date:     2012-02-27 02:06:22 +0000 (Mon, 27 Feb 2012)
Log Message:
-----------
Automatic creation of Resources ml file in Makefile. Using Resources ml instead of reading from files makes tests work in JS.

Modified Paths:
--------------
    trunk/Toss/Client/JsHandler.ml
    trunk/Toss/Client/clientTest.js
    trunk/Toss/Formula/.cvsignore
    trunk/Toss/Formula/AuxIO.ml
    trunk/Toss/Formula/AuxIO.mli
    trunk/Toss/Formula/BoolFunctionTest.ml
    trunk/Toss/Formula/OUnit.ml
    trunk/Toss/GGP/TranslateGameTest.ml
    trunk/Toss/Learn/LearnGameTest.ml
    trunk/Toss/Makefile
    trunk/Toss/Play/GameTreeTest.ml
    trunk/Toss/Play/HeuristicTest.ml
    trunk/Toss/Play/PlayTest.ml
    trunk/Toss/Server/ReqHandlerTest.ml
    trunk/Toss/Solver/ClassTest.ml

Added Paths:
-----------
    trunk/Toss/Formula/Resources.mli

Property Changed:
----------------
    trunk/Toss/Formula/

Modified: trunk/Toss/Client/JsHandler.ml
===================================================================
--- trunk/Toss/Client/JsHandler.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Client/JsHandler.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -264,3 +264,4 @@
 let run_tests_big s = run_tests (of_js s) true
 
 let _ = set_handle "run_tests_small" run_tests_small
+let _ = set_handle "run_tests_big" run_tests_big

Modified: trunk/Toss/Client/clientTest.js
===================================================================
--- trunk/Toss/Client/clientTest.js	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Client/clientTest.js	2012-02-27 02:06:22 UTC (rev 1680)
@@ -88,9 +88,9 @@
 	    return (existsId ("pred_b2_P"));
 	});
 	doAtTime (page, 4100, function () {
-	    ASYNCH ("run_tests_small", ["Formula"], function () {});
+	    ASYNCH ("run_tests_small", [""], function () {});
 	});
-	doAtTime (undefined, 20000, function () {
+	doAtTime (undefined, 900000, function () {
 	    //console.log ("rendering");
 	    //page.render ("clientTestRender.png");
 	    phantom.exit();


Property changes on: trunk/Toss/Formula
___________________________________________________________________
Modified: svn:ignore
   - # We are still using .cvsignore files as we find them easier to manage
# than svn properties. Therefore if you change .cvsignore do the following.
#     svn propset svn:ignore -F .cvsignore .

*Profile.log
*~

   + # We are still using .cvsignore files as we find them easier to manage
# than svn properties. Therefore if you change .cvsignore do the following.
#     svn propset svn:ignore -F .cvsignore .

Resources.ml
*~


Modified: trunk/Toss/Formula/.cvsignore
===================================================================
--- trunk/Toss/Formula/.cvsignore	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Formula/.cvsignore	2012-02-27 02:06:22 UTC (rev 1680)
@@ -2,5 +2,5 @@
 # than svn properties. Therefore if you change .cvsignore do the following.
 #     svn propset svn:ignore -F .cvsignore .
 
-*Profile.log
+Resources.ml
 *~

Modified: trunk/Toss/Formula/AuxIO.ml
===================================================================
--- trunk/Toss/Formula/AuxIO.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Formula/AuxIO.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -32,21 +32,33 @@
   ) ENDIF
 
 
-let rec input_file file =
-  let buf = Buffer.create 256 in
-  (try
-     while true do Buffer.add_channel buf file 1 done
-   with End_of_file -> ());
-  Buffer.contents buf
+let input_file fn_in = 
+  let fn = 
+    if String.length fn_in > 2 && fn_in.[0] = '.' && fn_in.[1] = '/' then
+      String.sub fn_in 2 ((String.length fn_in) - 2)
+    else fn_in in
+  IFDEF JAVASCRIPT THEN (
+    Resources.get_file fn
+  ) ELSE (
+    try Resources.get_file fn with Not_found -> (
+      let input_file_desc file =
+	let buf = Buffer.create 256 in
+	(try
+	   while true do Buffer.add_channel buf file 1 done
+	 with End_of_file -> ());
+	Buffer.contents buf in
+      let f = open_in fn in
+      let res = input_file_desc f in
+      close_in f;
+      print_endline ("WARNING: file " ^ fn ^ " not in resources");
+      res
+    )
+  ) ENDIF
 
-let input_fname fn = 
-  let f = open_in fn in
-  let res = input_file f in
-  close_in f; res
 
 let list_dir dirname =
   IFDEF JAVASCRIPT THEN (
-    failwith "JavaScript file manipulation not implemented yet"
+    failwith "JavaScript file manipulation not implemented"
   ) ELSE (
     let files, dir_handle = (ref [], Unix.opendir dirname) in
     let rec add () =

Modified: trunk/Toss/Formula/AuxIO.mli
===================================================================
--- trunk/Toss/Formula/AuxIO.mli	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Formula/AuxIO.mli	2012-02-27 02:06:22 UTC (rev 1680)
@@ -11,11 +11,8 @@
 (** Get a backtrace as a string (native mode only). *)
 val backtrace : unit -> string
 
-(** Input a file to a string. *)
-val input_file : in_channel -> string
-
 (** Input a file with given filename to a string. *)
-val input_fname : string -> string
+val input_file : string -> string
 
 (** List the contents of a directory *)
 val list_dir : string -> string list

Modified: trunk/Toss/Formula/BoolFunctionTest.ml
===================================================================
--- trunk/Toss/Formula/BoolFunctionTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Formula/BoolFunctionTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -125,9 +125,7 @@
   ] in
   Arg.parse opts (fun _ -> ()) "Try -help for help or one of the following.";
   if !file = "" then ignore (OUnit.run_test_tt ~verbose:true tests) else
-    let f = open_in !file in
-    let file_s = AuxIO.input_file f in
-    close_in f;
+    let file_s = AuxIO.input_file !file in
     let cleaned_s1 = Aux.replace_regexp ~regexp:"bool" ~templ:"" file_s in
     let cleaned_s2 = 
       Aux.replace_regexp ~regexp:"^.*<.*$" ~templ:"" cleaned_s1 in

Modified: trunk/Toss/Formula/OUnit.ml
===================================================================
--- trunk/Toss/Formula/OUnit.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Formula/OUnit.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -171,9 +171,10 @@
     Some e
 
 let assert_raises ?msg exn (f: unit -> 'a) = 
-  let pexn = 
-    Printexc.to_string 
-  in
+  let pexn e = (* Correcting JS exception printing; just to make tests pass *)
+    let s = Printexc.to_string e in
+    if s = "Failure(Boo)" then "Failure(\"Boo\")" else
+      if s = "Failure(Foo)" then "Failure(\"Foo\")" else s in
   let get_error_string () =
     let str = 
       Format.sprintf 

Added: trunk/Toss/Formula/Resources.mli
===================================================================
--- trunk/Toss/Formula/Resources.mli	                        (rev 0)
+++ trunk/Toss/Formula/Resources.mli	2012-02-27 02:06:22 UTC (rev 1680)
@@ -0,0 +1,4 @@
+(** Automatically Constructed Resources File *)
+
+(** Get the contents of a recorded file given its path (under Toss/). *)
+val get_file : string -> string

Modified: trunk/Toss/GGP/TranslateGameTest.ml
===================================================================
--- trunk/Toss/GGP/TranslateGameTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/GGP/TranslateGameTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -51,7 +51,7 @@
     TranslateGame.translate_game ~playing_as:(Const player) game in
   let goal_name = game_name^"-simpl.toss" in
   (* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
-  let goal_str = AuxIO.input_file (open_in ("./GGP/tests/"^goal_name)) in
+  let goal_str = AuxIO.input_file ("./GGP/tests/" ^ goal_name) in
   let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
   let res_str = Arena.state_str (r_game, r_struc) in
   output_string resf res_str;
@@ -151,7 +151,7 @@
     TranslateGame.translate_game ~playing_as:(Const player) game in
   let goal_name = game_name^"-simpl.toss" in
   (* let goal = state_of_file ("./GGP/tests/"^goal_name) in *)
-  let goal_str = AuxIO.input_file (open_in ("./GGP/tests/"^goal_name)) in
+  let goal_str = AuxIO.input_file ("./GGP/tests/"^goal_name) in
   let resf = open_out ("./GGP/tests/"^game_name^"-temp.toss") in
   let res_str = Arena.state_str (r_game, r_struc) in
   output_string resf res_str;

Modified: trunk/Toss/Learn/LearnGameTest.ml
===================================================================
--- trunk/Toss/Learn/LearnGameTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Learn/LearnGameTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -109,7 +109,7 @@
     let tfiles = List.map (fun fn -> !dir ^ "/" ^ fn)
       (List.sort compare (List.filter is_test (AuxIO.list_dir !dir))) in
     let is_group g fn = String.sub fn ((String.length fn) - 4) 4 = "." ^ g in
-    let get_struc fn = try get_strucs (AuxIO.input_fname fn) with
+    let get_struc fn = try get_strucs (AuxIO.input_file fn) with
 	err -> print_endline ("Error in " ^ fn); raise err in
     let strucs_of_files fs = List.map get_struc fs in
     let (win0, win1, notwon, wrong) = 

Modified: trunk/Toss/Makefile
===================================================================
--- trunk/Toss/Makefile	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Makefile	2012-02-27 02:06:22 UTC (rev 1680)
@@ -56,7 +56,43 @@
 	ocamlc -I +camlp4 -pp "camlp4o pa_extend.cmo q_MLast.cmo" \
 		-c $<
 
+NAMEPATTERN = f$(subst .,_,$(subst -,_,$(subst /,_,$(basename $@))))
+%.resource:
+	@echo -n 'let $(NAMEPATTERN) = "' >> Formula/Resources.ml
+	@cat $(basename $@)  | sed 's/"/\\"/g' >> Formula/Resources.ml
+	@echo '"' >> Formula/Resources.ml
+	@echo '' >> Formula/Resources.ml
+	@echo 'let _ = files := ("$(basename $@)", $(NAMEPATTERN)) :: !files' \
+	  >> Formula/Resources.ml
+	@echo '' >> Formula/Resources.ml
+	@echo "Recorded $(basename $@) in Formula/Resources.ml"
 
+TOSSEXFILES = $(shell find examples -name "*.toss")
+TOSSEXRESC = $(addsuffix .resource, $(TOSSEXFILES))
+TOSSGGPFILES = $(shell find GGP/tests -name "*.toss")
+TOSSGGPRESC = $(addsuffix .resource, $(TOSSGGPFILES))
+
+new_resource_file:
+	@echo "(* Automatically Constructed Resources *)" > Formula/Resources.ml
+	@echo "" >> Formula/Resources.ml
+	@echo "let files = ref []" >> Formula/Resources.ml
+	@echo "" >> Formula/Resources.ml
+	@echo "let get_file fn = List.assoc fn !files" >> Formula/Resources.ml
+	@echo "" >> Formula/Resources.ml
+
+all_resources: $(TOSSEXRESC) $(TOSSGGPRESC) \
+	Server/ServerGDLTest.in.resource \
+	Server/ServerGDLTest.out.resource \
+	Server/ServerGDLTest.in2.resource \
+	Server/ServerGDLTest.out2.resource \
+
+Formula/Resources.ml:
+	@make new_resource_file > /dev/null
+	@make all_resources
+
+EXTDEPS = caml_extensions/pa_let_try.cmo caml_extensions/pa_log.cmo Formula/Resources.ml
+
+
 # -------- MAIN OCAMLBUILD PART --------
 
 # TODO: Hard-coded path to js_of_ocaml.
@@ -85,19 +121,19 @@
 
 .INC=MenhirLib,Formula,Formula/Sat,Formula/Sat/dpll,Solver/RealQuantElim,Solver/Num,Solver,Arena,Play,GGP,Learn,Server
 
-%.native: %.ml caml_extensions/pa_let_try.cmo caml_extensions/pa_log.cmo
+%.native: %.ml $(EXTDEPS)
 	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
 
-%.p.native: %.ml caml_extensions/pa_let_try.cmo caml_extensions/pa_log.cmo
+%.p.native: %.ml $(EXTDEPS)
 	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
 
-%.byte: %.ml caml_extensions/pa_let_try.cmo caml_extensions/pa_log.cmo
+%.byte: %.ml $(EXTDEPS)
 	$(OCAMLBUILDJS) -Is $($(subst /,INC,$(dir $@))) $@
 
-%.d.byte: %.ml caml_extensions/pa_let_try.cmo caml_extensions/pa_log.cmo
+%.d.byte: %.ml $(EXTDEPS)
 	$(OCAMLBUILD) -Is $($(subst /,INC,$(dir $@))) $@
 
-doc: caml_extensions/pa_let_try.cmo caml_extensions/pa_log.cmo
+doc: $(EXTDEPS)
 	$(OCAMLBUILD) $(.INC) Toss.docdir/index.html
 	make -C www code_doc_link
 
@@ -203,4 +239,4 @@
 	ocamlbuild -clean
 	rm -f *.cmx *.cmi *.o *.cmo *.a *.cmxa *.cma *.annot *~ TossServer
 	rm -f Formula/*~ Solver/*~ Arena/*~ Learn/*~ Play/*~ GGP/*~ Server/*~
-	rm -f caml_extensions/*.cmo caml_extensions/*.cmi
+	rm -f caml_extensions/*.cmo caml_extensions/*.cmi Formula/Resources.ml

Modified: trunk/Toss/Play/GameTreeTest.ml
===================================================================
--- trunk/Toss/Play/GameTreeTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Play/GameTreeTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -5,12 +5,10 @@
 let debug_level = ref 0
 
 let raw_state_of_file s =
-  if !debug_level > 0 then Printf.printf "Loading file %s...\n%!" s;
-  let f = open_in s in
-  let res =
-    ArenaParser.parse_game_state Lexer.lex
-      (Lexing.from_channel f) in
-  if !debug_level > 0 then Printf.printf "File %s loaded.\n%!" s;
+  LOG 1 "Loading file %s..." s;
+  let s = AuxIO.input_file s in
+  let res = ArenaParser.parse_game_state Lexer.lex (Lexing.from_string s) in
+  LOG 1 "File %s loaded." s;
   res
 
 let struc_of_str s =

Modified: trunk/Toss/Play/HeuristicTest.ml
===================================================================
--- trunk/Toss/Play/HeuristicTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Play/HeuristicTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -19,10 +19,10 @@
     (Lexing.from_string s) signat [] None
 
 let state_of_file s =
-  let f = open_in s in
+  let f = AuxIO.input_file s in
   let res =
     ArenaParser.parse_game_state Lexer.lex
-      (Lexing.from_channel f) in
+      (Lexing.from_string f) in
   res
 
 let assert_eq_str ?(msg="") x_in y_in = 

Modified: trunk/Toss/Play/PlayTest.ml
===================================================================
--- trunk/Toss/Play/PlayTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Play/PlayTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -5,12 +5,10 @@
 let debug_level = ref 0
 
 let raw_state_of_file s =
-  if !debug_level > 0 then Printf.printf "Loading file %s...\n%!" s;
-  let f = open_in s in
-  let res =
-    ArenaParser.parse_game_state Lexer.lex
-      (Lexing.from_channel f) in
-  if !debug_level > 0 then Printf.printf "File %s loaded.\n%!" s;
+  LOG 1 "Loading file %s..." s;
+  let s = AuxIO.input_file s in
+  let res = ArenaParser.parse_game_state Lexer.lex (Lexing.from_string s) in
+  LOG 1 "File %s loaded." s;
   res
 
 let struc_of_str s =

Modified: trunk/Toss/Server/ReqHandlerTest.ml
===================================================================
--- trunk/Toss/Server/ReqHandlerTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Server/ReqHandlerTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -17,10 +17,8 @@
 	  state := fst (ReqHandler.full_req_handle !state in_ch out_ch) done
        with End_of_file -> ());
       close_in in_ch; close_out out_ch;
-      let result =
-        AuxIO.input_file (open_in "./Server/ServerGDLTest.temp") in
-      let target =
-        AuxIO.input_file (open_in "./Server/ServerGDLTest.out2") in
+      let result = AuxIO.input_file ("./Server/ServerGDLTest.temp") in
+      let target = AuxIO.input_file ("./Server/ServerGDLTest.out2") in
       Sys.remove "./Server/ServerGDLTest.temp";
       assert_equal ~printer:(fun x->x)
         (strip_spaces target) (strip_spaces result);

Modified: trunk/Toss/Solver/ClassTest.ml
===================================================================
--- trunk/Toss/Solver/ClassTest.ml	2012-02-18 21:54:05 UTC (rev 1679)
+++ trunk/Toss/Solver/ClassTest.ml	2012-02-27 02:06:22 UTC (rev 1680)
@@ -447,9 +447,7 @@
     ignore (OUnit.run_test_tt ~verbose:true tests);
     ignore (OUnit.run_test_tt ~verbose:true bigtests);
   ) else (
-    let f = open_in !file in
-    let s = AuxIO.input_file f in
-    close_in f;
+    let s = AuxIO.input_file !file in
     let i = String.index s '|' in (* enough to find "|=" here *)
     let cl_s = String.sub s 0 i in
     let phi_s = String.sub s (i+2) ((String.length s) - i - 3) in

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.