From 2701d3a832514ee94d110dfbd4f46f2ab6d9637e Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 21 Feb 2012 16:01:31 +0000 Subject: [PATCH] Add unit variable type and 'reloaded()' function. The reloaded() function is true only when we have just loaded a new file. This lets you initialize variables, with some caveats. --- daemon/daemon.ml | 6 +-- lib/whenproto.x | 11 +++-- lib/whenutils.ml | 89 ++++++++++++++++++++++++------------- lib/whenutils.mli | 13 ++++-- tests/jobs/t100_counter.ml | 6 +++ tests/jobs/t100_counter.ml.expected | 7 +-- tests/jobs/t101_updown.ml | 6 +++ tests/jobs/t101_updown.ml.expected | 16 ++++--- tests/parsing/t020_simple.ml | 5 +++ tools/whenjobs.ml | 12 ++++- 10 files changed, 116 insertions(+), 55 deletions(-) diff --git a/daemon/daemon.ml b/daemon/daemon.ml index 47a67ed..1155f50 100644 --- a/daemon/daemon.ml +++ b/daemon/daemon.ml @@ -198,7 +198,7 @@ and reload_file () = dependencies := map in (* Re-evaluate all when jobs. *) - reevaluate_whenjobs (StringMap.keys !jobs); + reevaluate_whenjobs ~onload:true (StringMap.keys !jobs); (* Schedule the next every job to run. *) schedule_next_everyjob () @@ -207,7 +207,7 @@ and reload_file () = * a fixpoint. Run those that need to be run. every-statement jobs * are ignored here. *) -and reevaluate_whenjobs jobnames = +and reevaluate_whenjobs ?(onload=false) jobnames = let rec loop set jobnames = let set' = List.fold_left ( @@ -218,7 +218,7 @@ and reevaluate_whenjobs jobnames = assert (jobname = job.job_name); let r, job' = - try job_evaluate job !variables + try job_evaluate job !variables onload with Invalid_argument err | Failure err -> Syslog.error "error evaluating job %s (at %s): %s" jobname (Camlp4.PreCast.Ast.Loc.to_string job.job_loc) err; diff --git a/lib/whenproto.x b/lib/whenproto.x index 2e64636..2ca662f 100644 --- a/lib/whenproto.x +++ b/lib/whenproto.x @@ -44,13 +44,16 @@ union status switch (status_code s) { }; enum variable_type { - BOOL_T = 0, - STRING_T = 1, - INT_T = 2, - FLOAT_T = 3 + UNIT_T = 0, + BOOL_T = 1, + STRING_T = 2, + INT_T = 3, + FLOAT_T = 4 }; union variable switch (variable_type t) { + case UNIT_T: + void; case BOOL_T: bool b; case STRING_T: diff --git a/lib/whenutils.ml b/lib/whenutils.ml index d53ac7e..fd066b4 100644 --- a/lib/whenutils.ml +++ b/lib/whenutils.ml @@ -52,6 +52,7 @@ let rec filter_map f = function | None -> filter_map f xs type whenexpr = + | Expr_unit | Expr_bool of bool | Expr_str of string | Expr_int of Big_int.big_int @@ -74,11 +75,13 @@ type whenexpr = | Expr_increases of string | Expr_decreases of string | Expr_prev of string + | Expr_reloaded (* This internal type is used during conversion of the OCaml AST * to the whenexpr type. *) type whenexpr_int = + | IExpr_unit | IExpr_bool of bool | IExpr_str of string | IExpr_int of Big_int.big_int @@ -104,18 +107,21 @@ type shell_script = { } type variable = + | T_unit | T_bool of bool | T_string of string | T_int of big_int | T_float of float let variable_of_rpc = function + | `unit_t -> T_unit | `bool_t b -> T_bool b | `string_t s -> T_string s | `int_t i -> T_int (big_int_of_string i) | `float_t f -> T_float f let rpc_of_variable = function + | T_unit -> `unit_t | T_bool b -> `bool_t b | T_string s -> `string_t s | T_int i -> `int_t (string_of_big_int i) @@ -155,6 +161,7 @@ let rec expr_of_ast _loc ast = expr_of_iexpr _loc (iexpr_of_ast _loc ast) and iexpr_of_ast _loc = function + | ExId (_, IdUid (_, "()")) -> IExpr_unit | ExId (_, IdUid (_, "True")) -> IExpr_bool true | ExId (_, IdUid (_, "False")) -> IExpr_bool false | ExStr (_, str) -> IExpr_str str @@ -190,6 +197,7 @@ and uncurry_app_tree _loc = function invalid_arg (sprintf "%s: invalid expression" (Loc.to_string _loc)) and expr_of_iexpr _loc = function + | IExpr_unit -> Expr_unit | IExpr_bool b -> Expr_bool b | IExpr_str s -> Expr_str s | IExpr_int i -> Expr_int i @@ -251,6 +259,12 @@ and expr_of_iexpr _loc = function invalid_arg (sprintf "%s: '%s' operator must be followed by a variable name" (Loc.to_string _loc) op) + | IExpr_app ("reloaded", [IExpr_unit]) -> + Expr_reloaded + + | IExpr_app ("reloaded", _) -> + invalid_arg (sprintf "%s: you must use 'reloaded ()'" (Loc.to_string _loc)) + | IExpr_app (op, _) -> invalid_arg (sprintf "%s: unknown operator in expression: %s" (Loc.to_string _loc) op) @@ -270,6 +284,7 @@ and one_param _loc op exprs f = op (Loc.to_string _loc)) let rec string_of_whenexpr = function + | Expr_unit -> "()" | Expr_bool b -> sprintf "%b" b | Expr_str s -> sprintf "%S" s | Expr_int i -> sprintf "%s" (string_of_big_int i) @@ -304,6 +319,7 @@ let rec string_of_whenexpr = function | Expr_increases v -> sprintf "increases %s" v | Expr_decreases v -> sprintf "decreases %s" v | Expr_prev v -> sprintf "prev %s" v + | Expr_reloaded -> "reloaded ()" let string_of_periodexpr = function | Every_seconds 1 -> "1 second" @@ -316,6 +332,7 @@ let string_of_periodexpr = function | Every_years i -> sprintf "%d years" i let rec dependencies_of_whenexpr = function + | Expr_unit -> [] | Expr_bool _ -> [] | Expr_str _ -> [] | Expr_int _ -> [] @@ -340,12 +357,14 @@ let rec dependencies_of_whenexpr = function | Expr_increases v | Expr_decreases v | Expr_prev v -> [v] + | Expr_reloaded -> [] let dependencies_of_job = function | { job_cond = When_job whenexpr } -> dependencies_of_whenexpr whenexpr | { job_cond = Every_job _ } -> [] -let rec eval_whenexpr job variables = function +let rec eval_whenexpr job variables onload = function + | Expr_unit -> T_unit | Expr_bool b -> T_bool b | Expr_str s -> T_string s | Expr_int i -> T_int i @@ -355,88 +374,88 @@ let rec eval_whenexpr job variables = function (try StringMap.find v variables with Not_found -> T_string "") | Expr_and (e1, e2) -> - if eval_whenexpr_as_bool job variables e1 && - eval_whenexpr_as_bool job variables e2 then + if eval_whenexpr_as_bool job variables onload e1 && + eval_whenexpr_as_bool job variables onload e2 then T_bool true else T_bool false | Expr_or (e1, e2) -> - if eval_whenexpr_as_bool job variables e1 || - eval_whenexpr_as_bool job variables e2 then + if eval_whenexpr_as_bool job variables onload e1 || + eval_whenexpr_as_bool job variables onload e2 then T_bool true else T_bool false | Expr_lt (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in if compare_values e1 e2 < 0 then T_bool true else T_bool false | Expr_le (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in if compare_values e1 e2 <= 0 then T_bool true else T_bool false | Expr_eq (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in if compare_values e1 e2 = 0 then T_bool true else T_bool false | Expr_ge (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in if compare_values e1 e2 >= 0 then T_bool true else T_bool false | Expr_gt (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in if compare_values e1 e2 > 0 then T_bool true else T_bool false | Expr_not e -> - if not (eval_whenexpr_as_bool job variables e) then + if not (eval_whenexpr_as_bool job variables onload e) then T_bool true else T_bool false | Expr_add (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in add_values e1 e2 | Expr_sub (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in sub_values e1 e2 | Expr_mul (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in mul_values e1 e2 | Expr_div (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in div_values e1 e2 | Expr_mod (e1, e2) -> - let e1 = eval_whenexpr job variables e1 - and e2 = eval_whenexpr job variables e2 in + let e1 = eval_whenexpr job variables onload e1 + and e2 = eval_whenexpr job variables onload e2 in mod_values e1 e2 | Expr_changes v -> @@ -461,8 +480,11 @@ let rec eval_whenexpr job variables = function T_bool false | Expr_prev v -> - try StringMap.find v job.job_private.job_prev_variables - with Not_found -> T_string "" + (try StringMap.find v job.job_private.job_prev_variables + with Not_found -> T_string "") + + | Expr_reloaded -> + T_bool onload and get_prev_curr_value job variables v = let prev_value = @@ -474,8 +496,9 @@ and get_prev_curr_value job variables v = prev_value, curr_value (* Call {!eval_whenexpr} and cast the result to a boolean. *) -and eval_whenexpr_as_bool job variables expr = - match eval_whenexpr job variables expr with +and eval_whenexpr_as_bool job variables onload expr = + match eval_whenexpr job variables onload expr with + | T_unit -> false | T_bool r -> r | T_string s -> s <> "" | T_int i -> sign_big_int i <> 0 @@ -559,22 +582,24 @@ and mod_values value1 value2 = (printable_string_of_variable value2)) and string_of_variable = function + | T_unit -> "" (* for string_of_variable, we don't want () here *) | T_bool b -> string_of_bool b | T_string s -> s | T_int i -> string_of_big_int i | T_float f -> string_of_float f and printable_string_of_variable = function + | T_unit -> "()" | T_bool b -> string_of_bool b | T_string s -> sprintf "%S" s | T_int i -> string_of_big_int i | T_float f -> string_of_float f -let job_evaluate job variables = +let job_evaluate job variables onload = match job with | { job_cond = Every_job _ } -> false, job | { job_cond = When_job whenexpr } -> - let state = eval_whenexpr_as_bool job variables whenexpr in + let state = eval_whenexpr_as_bool job variables onload whenexpr in (* Because jobs are edge-triggered, we're only interested in the * case where the evaluation state changes from false -> true. diff --git a/lib/whenutils.mli b/lib/whenutils.mli index 73d5084..13bc68c 100644 --- a/lib/whenutils.mli +++ b/lib/whenutils.mli @@ -125,6 +125,7 @@ val filter_map : ('a -> 'b option) -> 'a list -> 'b list (** Filter + map. *) type whenexpr = + | Expr_unit (** Unit constant. *) | Expr_bool of bool (** A boolean constant. *) | Expr_str of string (** A string constant. *) | Expr_int of Big_int.big_int (** An integer constant. *) @@ -147,6 +148,7 @@ type whenexpr = | Expr_increases of string (** increases var *) | Expr_decreases of string (** decreases var *) | Expr_prev of string (** prev var *) + | Expr_reloaded (** reloaded () *) (** Internal type used to represent 'when' expressions. *) type periodexpr = @@ -163,6 +165,7 @@ type shell_script = { (** A shell script. *) type variable = + | T_unit | T_bool of bool | T_string of string | T_int of Big_int.big_int @@ -214,10 +217,12 @@ val dependencies_of_whenexpr : whenexpr -> string list val dependencies_of_job : job -> string list (** Which variables does this job depend on? *) -val job_evaluate : job -> variables -> bool * job -(** Evaluate [job]'s condition in the context of the [variables], and - return [true] iff it should be run now. Note that this returns a - possibly-updated [job] structure. +val job_evaluate : job -> variables -> bool -> bool * job +(** [job_evaluate job variables onload] evaluates [job]'s condition in + the context of the [variables], and return [true] iff it should be + run now. + + Note that this returns a possibly-updated [job] structure. This is a no-op for 'every' jobs. *) diff --git a/tests/jobs/t100_counter.ml b/tests/jobs/t100_counter.ml index fd264f1..78471ec 100644 --- a/tests/jobs/t100_counter.ml +++ b/tests/jobs/t100_counter.ml @@ -18,6 +18,12 @@ (* Test count to 3, then fire a whenjob. *) +when reloaded () : +<< + echo $JOBSERIAL $JOBNAME >\> $HOME/test_output + whenjobs --set counter 0 --type int +>> + every 2 seconds : << echo $JOBSERIAL $JOBNAME $counter >\> $HOME/test_output diff --git a/tests/jobs/t100_counter.ml.expected b/tests/jobs/t100_counter.ml.expected index a8c6141..7b8a255 100644 --- a/tests/jobs/t100_counter.ml.expected +++ b/tests/jobs/t100_counter.ml.expected @@ -1,4 +1,5 @@ 1 job$1 -2 job$1 1 -3 job$1 2 -4 job$2 3 +2 job$2 0 +3 job$2 1 +4 job$2 2 +5 job$3 3 diff --git a/tests/jobs/t101_updown.ml b/tests/jobs/t101_updown.ml index af9425d..791a58b 100644 --- a/tests/jobs/t101_updown.ml +++ b/tests/jobs/t101_updown.ml @@ -20,6 +20,12 @@ * start running twice per period. *) +when reloaded () : +<< + echo $JOBSERIAL $JOBNAME >\> $HOME/test_output + whenjobs --set counter 0 --type int +>> + every second : << echo $JOBSERIAL $JOBNAME >\> $HOME/test_output diff --git a/tests/jobs/t101_updown.ml.expected b/tests/jobs/t101_updown.ml.expected index 277fd32..7dbb4ef 100644 --- a/tests/jobs/t101_updown.ml.expected +++ b/tests/jobs/t101_updown.ml.expected @@ -1,10 +1,12 @@ 1 job$1 2 job$3 -3 job$1 -4 job$2 -5 job$1 +3 job$2 +4 job$4 +5 job$2 6 job$3 -7 job$1 -8 job$2 -9 job$1 -10 job$4 +7 job$2 +8 job$4 +9 job$2 +10 job$3 +11 job$2 +12 job$5 diff --git a/tests/parsing/t020_simple.ml b/tests/parsing/t020_simple.ml index 8a3d666..f7f0778 100644 --- a/tests/parsing/t020_simple.ml +++ b/tests/parsing/t020_simple.ml @@ -35,6 +35,11 @@ every 30 minutes : # nothing >> +when reloaded () : +<< + # nothing +>> + when changes foo : << # nothing diff --git a/tools/whenjobs.ml b/tools/whenjobs.ml index 60795ba..f8a0659 100644 --- a/tools/whenjobs.ml +++ b/tools/whenjobs.ml @@ -87,7 +87,7 @@ let rec main () = "--list", Arg.Unit (set_mode `List), " List the script"; "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo"; "--set", Arg.Unit (set_mode `Set), " Set the variable"; - "--type", Arg.Set_string typ, "bool|int|float|string Set the variable type"; + "--type", Arg.Set_string typ, "bool|int|float|string|unit Set the variable type"; "--upload", Arg.Unit (set_mode `Upload), " Upload the script"; "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values"; "-V", Arg.Unit display_version, " Display version number and exit"; @@ -130,6 +130,7 @@ Options: | "string" -> `String | "int" -> `Int | "float"|"double" -> `Float + | "unit" -> `Unit | t -> eprintf "whenjobs: --type: unknown type (%s)\n" t; exit 1 in @@ -293,7 +294,13 @@ and set_variable name value typ = with Failure _ -> eprintf "whenjobs: variable is not a floating point number\n"; exit 1 - ) in + ) + | `Unit -> + if value <> "" then ( + eprintf "whenjobs: unit variables must be empty strings\n"; + exit 1 + ); + `unit_t in let client = start_client () in (match Whenproto_clnt.When.V1.set_variable client (name, value) with @@ -384,6 +391,7 @@ and stop_client client = Rpc_client.shut_down client and string_of_variable = function + | `unit_t -> "" | `bool_t b -> string_of_bool b | `string_t s -> s | `int_t i -> i (* passed on the wire as a string *) -- 1.8.3.1