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.

diff --git a/daemon/daemon.ml b/daemon/daemon.ml
index 47a67ed..1155f50 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 *)