ocamltest: make it possible to declare variables in the DSL

ocamltest/tsl_ast.ml

@@ -21,7 +21,7 @@ type 'a located = {
 }
 
 type environment_statement =
-  | Assignment of string located * string located (* variable = value *)
+  | Assignment of bool * string located * string located (* variable = value *)
   | Append of string located * string located
   | Include of string located (* include named environemnt *)
 

ocamltest/tsl_ast.mli

@@ -21,7 +21,7 @@ type 'a located = {
 }
 
 type environment_statement =
-  | Assignment of string located * string located (* variable = value *)
+  | Assignment of bool * string located * string located (* variable = value *)
   | Append of string located * string located (* variable += value *)
   | Include of string located (* include named environemnt *)
 

ocamltest/tsl_lexer.mll

@@ -45,6 +45,7 @@ rule token = parse
     { let s = Lexing.lexeme lexbuf in
       match s with
         | "include" -> INCLUDE
+        | "set" -> SET
         | "with" -> WITH
         | _ -> IDENTIFIER s
     }

ocamltest/tsl_parser.mly

@@ -37,7 +37,7 @@ let mkenvstmt envstmt =
 %token <int> TEST_DEPTH
 %token EQUAL PLUSEQUAL
 /* %token COLON */
-%token INCLUDE WITH
+%token INCLUDE SET WITH
 %token <string> IDENTIFIER
 %token <string> STRING
 
@@ -71,9 +71,12 @@ opt_environment_modifiers:
 
 env_item:
 | identifier EQUAL string
-    { mkenvstmt (Assignment ($1, $3)) }
+    { mkenvstmt (Assignment (false, $1, $3)) }
 | identifier PLUSEQUAL string
     { mkenvstmt (Append ($1, $3)) }
+| SET identifier EQUAL string
+    { mkenvstmt (Assignment (true, $2, $4)) }
+
 | INCLUDE identifier
   { mkenvstmt (Include $2) }
 

ocamltest/tsl_semantics.ml

@@ -41,7 +41,20 @@ let apply_modifiers env modifiers_name =
   | Environments.Modifiers_name_not_found name ->
     no_such_modifiers modifiers_name.loc name
 
-let add_or_append f loc variable_name value env =
+let rec add_to_env decl loc variable_name value env =
+  match (Variables.find_variable variable_name, decl) with
+    | (None, true) ->
+      let newvar = Variables.make (variable_name,"User variable") in
+      Variables.register_variable newvar;
+      add_to_env false loc variable_name value env
+    | (Some variable, false) ->
+      Environments.add variable value env
+    | (None, false) ->
+      raise (Variables.No_such_variable variable_name)
+    | (Some _, true) ->
+      raise (Variables.Variable_already_registered variable_name)
+
+let append_to_env loc variable_name value env =
   let variable =
     match Variables.find_variable variable_name with
     | None ->
@@ -50,15 +63,15 @@ let add_or_append f loc variable_name value env =
         variable
   in
   try
-    f variable value env
+    Environments.append variable value env
   with Variables.No_such_variable name ->
     no_such_variable loc name
 
 let interprete_environment_statement env statement = match statement.node with
-  | Assignment (var, value) ->
-      add_or_append Environments.add statement.loc var.node value.node env
+  | Assignment (decl, var, value) ->
+      add_to_env decl statement.loc var.node value.node env
   | Append (var, value) ->
-      add_or_append Environments.append statement.loc var.node value.node env
+      append_to_env statement.loc var.node value.node env
   | Include modifiers_name ->
       apply_modifiers env modifiers_name
 

ocamltest/variables.ml

@@ -29,7 +29,7 @@ let compare v1 v2 = String.compare v1.variable_name v2.variable_name
 
 exception Empty_variable_name
 
-exception Variable_already_registered
+exception Variable_already_registered of string
 
 exception No_such_variable of string
 
@@ -57,7 +57,7 @@ let (variables : (string, t) Hashtbl.t) = Hashtbl.create 10
 
 let register_variable variable =
   if Hashtbl.mem variables variable.variable_name
-  then raise Variable_already_registered
+  then raise (Variable_already_registered variable.variable_name)
   else Hashtbl.add variables variable.variable_name variable
 
 let find_variable variable_name =

ocamltest/variables.mli

@@ -25,7 +25,7 @@ val compare : t -> t -> int
 
 exception Empty_variable_name
 
-exception Variable_already_registered
+exception Variable_already_registered of string
 
 exception No_such_variable of string