Commit 0f7c0947 authored by Erwan Jahier's avatar Erwan Jahier
Browse files

lurette 0.79 Thu, 29 Aug 2002 16:55:47 +0200 by jahier

Parent-Version:      0.78
Version-Log:

source/lurettetop.ml:
   Add a pack command and a --restore option to lurettetop that respectively
   save temporarily created files during a session and restore them
   later on.

   Also clean-up temporarily created files when lurettetop resumes.

Project-Description: Lurette
parent 98bd35d5
;; -*- Prcs -*-
(Created-By-Prcs-Version 1 3 3)
(Project-Description "Lurette")
(Project-Version lurette 0 78)
(Parent-Version lurette 0 77)
(Project-Version lurette 0 79)
(Parent-Version lurette 0 78)
(Version-Log "
source/parse_env.ml:
Fix a bug where empty ctrl expr labels were causing
a parse error.
source/lurettetop.ml:
Add a pack command and a --restore option to lurettetop that respectively
save temporarily created files during a session and restore them
later on.
source/control.ml,mli:
Add those files to the project as should have been done for a while...
Do not handle infinite values for ctrl expr counters anymore as it is
useless (and not so easy to be handled properly).
Also clean-up temporarily created files when lurettetop resumes.
")
(New-Version-Log "")
(Checkin-Time "Thu, 29 Aug 2002 15:19:15 +0200")
(Checkin-Time "Thu, 29 Aug 2002 16:55:47 +0200")
(Checkin-Login jahier)
(Populate-Ignore ())
(Project-Keywords)
......@@ -82,7 +79,7 @@ source/control.ml,mli:
(source/gne.mli (lurette/b/36_gne.mli 1.2 644))
(source/gne.ml (lurette/b/37_gne.ml 1.2 644))
(source/lurettetop.ml (lurette/c/1_lurettetop 1.3 644))
(source/lurettetop.ml (lurette/c/1_lurettetop 1.4 644))
(source/gen_stubs.ml (lurette/24_generate_l 1.30 644))
(source/control.mli (lurette/c/3_control.ml 1.1 644))
......
......@@ -35,6 +35,7 @@ type flagT = {
mutable output : string ;
mutable make_opt : string ;
mutable go : bool ref ;
mutable restore : string option;
(* a flag to know whether lurette_exe needs to be (re-)build *)
mutable to_build : bool ref
}
......@@ -55,6 +56,7 @@ let (flag : flagT) = {
verbose = ref false ;
output = "lurette.rif" ;
go = ref false ;
restore = None ;
to_build = ref true
}
......@@ -101,6 +103,10 @@ let rec speclist =
"\t\t\tStart the testing process directly without prompting.";
"-go", Arg.Set flag.go, "\n";
"--restore", Arg.String (fun s -> flag.restore <- Some s),
"<string>\tFile name (without extension) of the package containing"
^ "\t\tthe temporarily files to be restored (cf the pack command).\n";
"--step", Arg.Set flag.step_by_step, "\t\tRun lurette step by step." ;
"-s", Arg.Set flag.step_by_step, "\n";
......@@ -171,7 +177,8 @@ let (build : string -> string -> string -> bool) =
)
let (run : string -> bool) =
(* run lurette and returns the exit status *)
let (run : string -> int) =
fun lurette_tmp_dir ->
let seed_str =
match flag.seed with
......@@ -198,7 +205,7 @@ let (run : string -> bool) =
)
in
print_string (run_cmd ^ "\n");
(Sys.command run_cmd) = 0
Sys.command run_cmd
......@@ -223,6 +230,7 @@ type cmd =
| Quit
| Help
| Man
| Pack of string
| Show
| HelpSimple
| Error of string
......@@ -273,6 +281,8 @@ let rec
| [< 'Genlex.Ident "man" >] -> Man
| [< 'Genlex.Ident "pack" ; 'Genlex.Ident file >] -> Pack(file)
| [< 'Genlex.Ident "help" >] -> Help
| [< 'Genlex.Ident "h" >] -> Help
| [< 'Genlex.Ident "?" >] -> Help
......@@ -341,6 +351,11 @@ man
clean
run a make clean (you can try it if <<run>> failed)
pack <file_name>
package up in <file_name>.tgz files created in a temporary
directory. This file can then be given in argument of the
<<--restore>> option of lurettetop so that they are not
computed again.
show
show of post-script version of the current environment
......@@ -473,8 +488,8 @@ let rec (main_loop : string -> string -> string -> unit) =
(
flag.to_build := false;
Unix.chdir user_dir;
let result = run lurette_tmp_dir in
if not result
let result = run lurette_tmp_dir in
if result <> 0
then output_string stderr "Can not run lurette.\n"
)
else
......@@ -487,6 +502,14 @@ let rec (main_loop : string -> string -> string -> unit) =
| HelpSimple -> print_string cmd_usage; true
| Help -> display_cmd (); true
| Man -> print_string man ; true
| Pack(file) ->
(* XXX autoconf: gnu tar ougth to be installed ! *)
let cmd = ("mv " ^ lurette_tmp_dir ^ " /tmp/" ^ file ^
"; cd " ^ user_dir ^ "; tar cvfz " ^
file ^ ".tgz /tmp/" ^ file ^ "; mv /tmp/" ^
file ^ " " ^ lurette_tmp_dir )
in
let _ = print_string (cmd ^ "\n") ; Sys.command cmd in true
| Error(errmsg) ->
print_string errmsg;
print_string cmd_usage;
......@@ -519,15 +542,27 @@ let (get_fresh_dir : unit -> string) =
get_fresh_dir_rec 1
let (rm_dir : string -> unit) =
fun dir ->
(* XXX probably not very portable ...*)
let cmd = ("rm -rf " ^ dir) in
print_string cmd;
print_string "\n";
flush stdout;
if Sys.command cmd <> 0
then print_string ("Can not remove" ^ dir ^ "\n")
let _ =
let user_dir = (Unix.getcwd ()) ^ "/" in
let lurette_tmp_dir = get_fresh_dir () in
let lurette_dir =
try Sys.getenv "LURETTE_PATH"
with _ ->
print_string "Environment var LURETTE_PATH is unset.\n";
exit 2
in
let _ =
try
Arg.parse speclist
(fun s ->
......@@ -535,23 +570,7 @@ let _ =
then flag.env <- (flag.env ^ " x ")
else flag.env <- (flag.env ^ s ^ ".ima ")
)
usage;
Unix.chdir lurette_tmp_dir;
if !(flag.go)
then
(
if build user_dir lurette_tmp_dir lurette_dir
then
(
Unix.chdir user_dir;
if run lurette_tmp_dir
then exit 0
else print_string "Can not run lurette_exe\n"
)
else print_string "Can not build lurette_exe\n"
)
else main_loop user_dir lurette_tmp_dir lurette_dir;
Unix.chdir user_dir
usage
with
Failure(e) ->
print_string e;
......@@ -559,7 +578,50 @@ let _ =
flush stderr ;
exit 2
| _ ->
exit 2
exit 2
in
let lurette_tmp_dir =
match flag.restore with
None -> get_fresh_dir ()
| Some file ->
(* XXX autoconf: gnu tar ougth to be installed ! *)
let cmd = ("cd /; tar xvfz " ^ user_dir ^ file ^ ".tgz") in
let _ = print_string (cmd ^ "\n"); Sys.command cmd in
("/tmp/" ^ file)
in
Unix.chdir lurette_tmp_dir;
if
!(flag.go)
then
(
if
build user_dir lurette_tmp_dir lurette_dir
then
(
Unix.chdir user_dir;
if
(run lurette_tmp_dir) <> 0
then
(
print_string "Can not run lurette_exe\n";
exit 1
);
rm_dir lurette_tmp_dir;
)
else
(
print_string "Can not build lurette_exe\n";
rm_dir lurette_tmp_dir;
exit 1
)
)
else
(* flag.go *)
(
main_loop user_dir lurette_tmp_dir lurette_dir;
Unix.chdir user_dir;
rm_dir lurette_tmp_dir
)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment