From f2e0ae8a17ef0d39281cdae29bd7efe14813418b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?S=C3=A9bastien=20Hinderer?= <Sebastien.Hinderer@inria.fr>
Date: Sun, 18 Mar 2018 09:05:14 +0100
Subject: [PATCH] ocamltest: make it possible to declare variables in the DSL

---
 ocamltest/tsl_ast.ml       |  2 +-
 ocamltest/tsl_ast.mli      |  2 +-
 ocamltest/tsl_lexer.mll    |  1 +
 ocamltest/tsl_parser.mly   |  7 +++++--
 ocamltest/tsl_semantics.ml | 23 ++++++++++++++++++-----
 ocamltest/variables.ml     |  4 ++--
 ocamltest/variables.mli    |  2 +-
 7 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/ocamltest/tsl_ast.ml b/ocamltest/tsl_ast.ml
index ea17167a6..fda94cb6c 100644
--- a/ocamltest/tsl_ast.ml
+++ b/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 *)
 
diff --git a/ocamltest/tsl_ast.mli b/ocamltest/tsl_ast.mli
index c7640603a..9fc47c214 100644
--- a/ocamltest/tsl_ast.mli
+++ b/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 *)
 
diff --git a/ocamltest/tsl_lexer.mll b/ocamltest/tsl_lexer.mll
index 338c8fa24..966483a3e 100644
--- a/ocamltest/tsl_lexer.mll
+++ b/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
     }
diff --git a/ocamltest/tsl_parser.mly b/ocamltest/tsl_parser.mly
index 0cf0f8922..eb891f6ab 100644
--- a/ocamltest/tsl_parser.mly
+++ b/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) }
 
diff --git a/ocamltest/tsl_semantics.ml b/ocamltest/tsl_semantics.ml
index 1a41bbd53..e9e163f2c 100644
--- a/ocamltest/tsl_semantics.ml
+++ b/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
 
diff --git a/ocamltest/variables.ml b/ocamltest/variables.ml
index e321bf843..9f8fa1b4f 100644
--- a/ocamltest/variables.ml
+++ b/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 =
diff --git a/ocamltest/variables.mli b/ocamltest/variables.mli
index f5a23a930..86b093d93 100644
--- a/ocamltest/variables.mli
+++ b/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