[Ptest] add a MODULE configuration option to build and load modules

doc/developer/advance.tex

@@ -928,6 +928,11 @@ file, run it only once.
 & Command used to filter results
 & \textit{None}
 \\
+& \texttt{MODULE}\sscodeidxdef{Test}{Directive}{FILTER}
+& Register a dynamic module to be built and to be loaded with each subsequent
+test
+& \textit{None}
+\\
 \hline \multirow{2}{23mm}{\centering{Test suite}}
 & \texttt{DONTRUN}\sscodeidxdef{Test}{Directive}{DONTRUN}
 & Do not execute this test

ptests/ptests.ml

@@ -493,8 +493,6 @@ end = struct
 
 end
 
-let macro_regex = Str.regexp "\\([^@]*\\)@\\([^@]*\\)@\\(.*\\)"
-
 type execnow =
     {
       ex_cmd: string;      (** command to launch *)
@@ -510,7 +508,77 @@ type execnow =
                                are duplicated using OCaml 'with' syntax. *)
     }
 
-module StringMap = Map.Make(String)
+
+module Macros =
+struct
+  module StringMap = Map.Make (String)
+  open StringMap
+
+  type t = string StringMap.t
+
+  let empty = StringMap.empty
+
+  let macro_regex = Str.regexp "\\([^@]*\\)@\\([^@]*\\)@\\(.*\\)"
+
+  let does_expand macros s =
+    if !verbosity >=2 then begin
+      lock_printf "looking for macros in string %s\n%!" s;
+      lock_printf "Existing macros:\n%!";
+      iter (fun s1 s2 -> lock_printf "%s => %s\n%!" s1 s2) macros;
+      lock_printf "End macros\n%!";
+    end;
+    let rec aux n (ptest_file_matched,s as acc) =
+      if Str.string_match macro_regex s n then begin
+        let macro = Str.matched_group 2 s in
+        let ptest_file_matched = ptest_file_matched || macro = "PTEST_FILE" in
+        let start = Str.matched_group 1 s in
+        let rest = Str.matched_group 3 s in
+        let new_n = Str.group_end 1 in
+        let n, new_s =
+          if macro = "" then begin
+            new_n + 1, String.sub s 0 new_n ^ "@" ^ rest
+          end else begin
+            try
+              if !verbosity >= 2 then lock_printf "macro is %s\n%!" macro;
+              let replacement =  find macro macros in
+              if !verbosity >= 1 then
+                lock_printf "replacement for %s is %s\n%!" macro replacement;
+              new_n,
+              String.sub s 0 n ^ start ^ replacement ^ rest
+            with
+            | Not_found -> Str.group_end 2 + 1, s
+          end
+        in
+        if !verbosity >= 2 then lock_printf "new string is %s\n%!" new_s;
+        let new_acc = ptest_file_matched, new_s in
+        if n <= String.length new_s then aux n new_acc else new_acc
+      end else acc
+    in
+    Mutex.lock str_mutex;
+    try
+      let res = aux 0 (false,s) in
+      Mutex.unlock str_mutex; res
+    with e ->
+      lock_eprintf "Uncaught exception %s\n%!" (Printexc.to_string e);
+      Mutex.unlock str_mutex;
+      raise e
+
+  let expand macros s =
+    snd (does_expand macros s)
+
+  let get ?(default="") name macros =
+    try find name macros with Not_found -> default
+
+  let add_list l map =
+    List.fold_left (fun acc (k,v) -> add k v acc) map l
+
+  let add_expand name def macros =
+    add name (expand macros def) macros
+
+  let append_expand name def macros =
+    add name (get name macros ^ expand macros def) macros
+end
+
 
 (** configuration of a directory/test. *)
 type config =
@@ -519,7 +587,7 @@ type config =
       dc_execnow    : execnow list; (** command to be launched before
                                          the toplevel(s)
                                      *)
-      dc_macros: string StringMap.t; (** existing macros. *)
+      dc_macros: Macros.t; (** existing macros. *)
       dc_default_toplevel   : string;
       (** full path of the default toplevel. *)
       dc_filter     : string option; (** optional filter to apply to
@@ -532,7 +600,11 @@ type config =
     }
 
 let default_macros () =
-  StringMap.add "frama-c" !toplevel_path StringMap.empty
+  let l = [
+    "frama-c", !toplevel_path;
+    "PTEST_MAKE_MODULE", "make -s"
+  ] in
+  Macros.add_list l Macros.empty
 
 let default_config () =
   { dc_test_regexp = test_file_regexp ;
@@ -570,48 +642,6 @@ let launch command_string =
         s command_string;
       exit 1
 
-let replace_macros macros s =
-  if !verbosity >=2 then begin
-    lock_printf "looking for macros in string %s\n%!" s;
-    lock_printf "Existing macros:\n%!";
-    StringMap.iter (fun s1 s2 -> lock_printf "%s => %s\n%!" s1 s2) macros;
-    lock_printf "End macros\n%!";
-  end;
-  let rec aux n (ptest_file_matched,s as acc) =
-    if Str.string_match macro_regex s n then begin
-      let macro = Str.matched_group 2 s in
-      let ptest_file_matched = ptest_file_matched || macro = "PTEST_FILE" in
-      let start = Str.matched_group 1 s in
-      let rest = Str.matched_group 3 s in
-      let new_n = Str.group_end 1 in
-      let n, new_s =
-        if macro = "" then begin
-          new_n + 1, String.sub s 0 new_n ^ "@" ^ rest
-        end else begin
-          try
-            if !verbosity >= 2 then lock_printf "macro is %s\n%!" macro;
-            let replacement =  StringMap.find macro macros in
-            if !verbosity >= 1 then
-              lock_printf "replacement for %s is %s\n%!" macro replacement;
-            new_n,
-            String.sub s 0 n ^ start ^ replacement ^ rest
-          with
-          | Not_found -> Str.group_end 2 + 1, s
-        end
-      in
-       if !verbosity >= 2 then lock_printf "new string is %s\n%!" new_s;
-      let new_acc = ptest_file_matched, new_s in
-      if n <= String.length new_s then aux n new_acc else new_acc
-    end else acc
-  in
-  Mutex.lock str_mutex;
-  try
-    let res = aux 0 (false,s) in
-    Mutex.unlock str_mutex; res
-  with e ->
-    lock_eprintf "Uncaught exception %s\n%!" (Printexc.to_string e);
-    Mutex.unlock str_mutex;
-    raise e
 
 let scan_execnow ~once dir (s:string) =
   let rec aux (s:execnow) =
@@ -675,7 +705,12 @@ let make_custom_opts =
     (* preserve options ordering *)
     List.fold_right (fun x s -> s ^ " " ^ x) opts ""
 
-let add_macro s macros =
+
+(* how to process options *)
+let config_exec ~once dir s current =
+  { current with dc_execnow = scan_execnow ~once dir s :: current.dc_execnow }
+
+let config_macro _dir s current =
   let regex = Str.regexp "[ \t]*\\([^ \t@]+\\)\\([ \t]+\\(.*\\)\\|$\\)" in
   Mutex.lock str_mutex;
   if Str.string_match regex s 0 then begin
@@ -686,14 +721,20 @@ let add_macro s macros =
     Mutex.unlock str_mutex;
     if !verbosity >= 1 then
       lock_printf "new macro %s with definition %s\n%!" name def;
-    StringMap.add name (snd (replace_macros macros def)) macros
+    { current with dc_macros = Macros.add_expand name def current.dc_macros }
   end else begin
     Mutex.unlock str_mutex;
     lock_eprintf "cannot understand MACRO definition: %s\n%!" s;
-    macros
+    current
   end
 
-(* how to process options *)
+let config_module dir s current =
+  let make_cmd = "@PTEST_MAKE_MODULE@ " ^ s in
+  let make_cmd = Macros.expand current.dc_macros make_cmd in
+  let current = config_exec ~once:true dir make_cmd current in
+  let k = "PTEST_LOAD_MODULES" and v = " -load-module " ^ s in
+  { current with dc_macros = Macros.append_expand k v current.dc_macros }
+
 let config_options =
   [ "CMD",
     (fun _ s current -> 
@@ -733,21 +774,14 @@ let config_options =
     "DONTRUN",
     (fun _ s current -> { current with dc_dont_run = true });
 
-    "EXECNOW",
-    (fun dir s current ->
-      let execnow = scan_execnow ~once:true dir s in
-      { current with dc_execnow = execnow::current.dc_execnow  });
-
-    "EXEC",
-    (fun dir s current ->
-      let execnow = scan_execnow ~once:false dir s in
-      { current with dc_execnow = execnow::current.dc_execnow  });
-
-    "MACRO", (fun _ s current ->
-      { current with dc_macros = add_macro s current.dc_macros });
+    "EXECNOW", config_exec ~once:true;
+    "EXEC", config_exec ~once:false;
+    "MACRO", config_macro;
+    "MODULE", config_module;
     "LOG",
     (fun _ s current ->
      { current with dc_default_log = s :: current.dc_default_log })
+
   ]
 
 let scan_options dir scan_buffer default =
@@ -825,7 +859,7 @@ let scan_test_file default dir f =
       { default with dc_dont_run = true }
 
 type toplevel_command =
-    { macros: string StringMap.t;
+    { macros: Macros.t;
       mutable log_files: string list;
       file : string ;
       nb_files : int ;
@@ -934,9 +968,7 @@ let get_macros cmd =
       "PTEST_NUMBER", string_of_int cmd.n;
     ]
   in
-  List.fold_left
-    (fun acc (macro,replace) -> StringMap.add macro replace acc)
-    cmd.macros macros
+  Macros.add_list macros cmd.macros
 
 let basic_command_string =
   let contains_toplevel_or_frama_c = 
@@ -944,22 +976,19 @@ let basic_command_string =
   in
   fun command ->
     let macros = get_macros command in
-    let logfiles =
-      List.fold_left
-        (fun acc s -> snd (replace_macros macros s) :: acc)
-        []
-        command.log_files
-    in
+    let logfiles = List.map (Macros.expand macros) command.log_files in
     command.log_files <- logfiles;
-    let has_ptest_file_t, toplevel = replace_macros macros command.toplevel in
-    let has_ptest_file_o, options = replace_macros macros command.options in
+    let has_ptest_file_t, toplevel = Macros.does_expand macros command.toplevel in
+    let has_ptest_file_o, options = Macros.does_expand macros command.options in
     let toplevel = if !use_byte then opt_to_byte toplevel else toplevel in
     let options =
       if str_string_match contains_toplevel_or_frama_c command.toplevel 0
       then begin
-        let opt_pre = snd (replace_macros macros !additional_options_pre) in
-        let opt_post = snd (replace_macros macros !additional_options) in
-        "-check " ^ opt_pre ^ " " ^ options ^ " " ^ opt_post
+        let opt_modules = Macros.expand macros
+            (Macros.get "PTEST_LOAD_MODULES" macros) in
+        let opt_pre = Macros.expand macros !additional_options_pre in
+        let opt_post = Macros.expand macros !additional_options in
+        "-check " ^ opt_modules ^ " " ^ opt_pre ^ " " ^ options ^ " " ^ opt_post
       end else options
     in
     let options = if !use_byte then opt_to_byte_options options else options in
@@ -1083,11 +1112,7 @@ let update_toplevel_command command =
     Unix.Unix_error _ -> ()
   end;
   let macros = get_macros command in
-  let log_files =
-    List.fold_left
-      (fun acc s -> snd (replace_macros macros s) :: acc)
-      []
-      command.log_files
+  let log_files = List.map (Macros.expand macros) command.log_files
   in
   List.iter (update_log_files command.directory) log_files
 
@@ -1605,7 +1630,7 @@ let dispatcher () =
             macros = config.dc_macros;
             execnow = true; }
       in
-      let process_macros s = snd (replace_macros config.dc_macros s) in
+      let process_macros s = Macros.expand config.dc_macros s in
       let make_execnow_cmd execnow =
         let res =
           {

tests/misc/behavior_names.i

 /* run.config
-   EXECNOW: make -s @PTEST_DIR@/@PTEST_NAME@.cmxs
-   OPT: -no-autoload-plugins -load-module @PTEST_DIR@/@PTEST_NAME@.cmxs
+   MODULE: @PTEST_DIR@/@PTEST_NAME@.cmxs
+   OPT: -no-autoload-plugins
 */
 
 /*@ behavior foo: ensures \true; */

tests/misc/debug_category.i

 /* run.config
-EXECNOW: make -s tests/misc/Debug_category.cmxs
-OPT: -load-module tests/misc/Debug_category.cmxs -test-msg-key help -test-warn-key="a=inactive"
-OPT: -load-module tests/misc/Debug_category.cmxs -test-msg-key a -test-warn-key="a=inactive"
-OPT: -load-module tests/misc/Debug_category.cmxs -test-msg-key a -test-msg-key="-a:b" -test-warn-key="a=inactive"
-OPT: -load-module tests/misc/Debug_category.cmxs -test-msg-key a -test-msg-key="-a:b" -test-msg-key a:b:c -test-warn-key="a=inactive"
-OPT: -load-module tests/misc/Debug_category.cmxs -test-msg-key "a:b:c,d" -test-warn-key="a=inactive"
-OPT: -load-module tests/misc/Debug_category.cmxs -test-msg-key "*" -test-warn-key="a=inactive"
-OPT: -load-module tests/misc/Debug_category.cmxs
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key a=error
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key a=abort
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key a=feedback
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key="*=abort"
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key=a=once
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key a=feedback-once
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key a=err-once
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key test-vis-err
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key test-inv-err
-OPT: -load-module tests/misc/Debug_category.cmxs -test-warn-key test-failure
+MODULE: tests/misc/Debug_category.cmxs
+OPT: -test-msg-key help -test-warn-key="a=inactive"
+OPT: -test-msg-key a -test-warn-key="a=inactive"
+OPT: -test-msg-key a -test-msg-key="-a:b" -test-warn-key="a=inactive"
+OPT: -test-msg-key a -test-msg-key="-a:b" -test-msg-key a:b:c -test-warn-key="a=inactive"
+OPT: -test-msg-key "a:b:c,d" -test-warn-key="a=inactive"
+OPT: -test-msg-key "*" -test-warn-key="a=inactive"
+OPT:
+OPT: -test-warn-key a=error
+OPT: -test-warn-key a=abort
+OPT: -test-warn-key a=feedback
+OPT: -test-warn-key="*=abort"
+OPT: -test-warn-key=a=once
+OPT: -test-warn-key a=feedback-once
+OPT: -test-warn-key a=err-once
+OPT: -test-warn-key test-vis-err
+OPT: -test-warn-key test-inv-err
+OPT: -test-warn-key test-failure
 FILTER: sed 's|Your Frama-C version is.*|Your Frama-C version is VERSION|'
 */