ocamltest: rename the source_modules variable to all_modules and make it public

This variable lists the files that need to be compiled and linked
to build a test.

By default, its value is derived from the "modules" variable and the
name of the test file. But it can now be overriden, which turns
out to be necessary, sometimes, e.g. when the modules have been
compiled separately.
master
Sébastien Hinderer 2018-02-07 19:06:31 +01:00
parent 11118e03ae
commit 1b87cdd1df
3 changed files with 11 additions and 11 deletions

View File

@ -88,11 +88,11 @@ let compile_program ocamlsrcdir compiler program_variable log env =
let env' = Environments.add program_variable p env in
(env', p)
| Some p -> (env, p) in
let source_modules =
Actions_helpers.words_of_variable env Ocaml_variables.source_modules in
let all_modules =
Actions_helpers.words_of_variable env Ocaml_variables.all_modules in
let modules =
List.concatmap prepare_module
(List.map Ocaml_filetypes.filetype source_modules) in
(List.map Ocaml_filetypes.filetype all_modules) in
let is_c_file (_filename, filetype) = filetype=Ocaml_filetypes.C in
let has_c_file = List.exists is_c_file modules in
let custom = (backend = Ocaml_backends.Bytecode) && has_c_file in
@ -205,7 +205,7 @@ let find_source_modules log env =
specified_modules in
print_module_names log "Source" source_modules;
Environments.add
Ocaml_variables.source_modules
Ocaml_variables.all_modules
(String.concat " " (List.map Ocaml_filetypes.make_filename source_modules))
env
@ -228,7 +228,7 @@ let setup_compiler_build_env compiler log env =
compiler_reference_variable compiler_reference_filename env
end in
let source_modules =
Actions_helpers.words_of_variable env Ocaml_variables.source_modules in
Actions_helpers.words_of_variable env Ocaml_variables.all_modules in
let compiler_directory_suffix =
Environments.safe_lookup Ocaml_variables.compiler_directory_suffix env in
let compiler_directory_name =

View File

@ -24,6 +24,9 @@
open Variables (* Should not be necessary with a ppx *)
let all_modules = make ("all_modules",
"All the modules to compile and link")
let c_preprocessor = make ("c_preprocessor",
"Command to use to invoke the C preprocessor")
@ -99,11 +102,9 @@ let ocamlsrcdir = make ("ocamlsrcdir",
let os_type = make ("os_type",
"The OS we are running on")
let source_modules = make ("source_modules",
"Complete list of modules (private)")
let _ = List.iter register_variable
[
all_modules;
c_preprocessor;
compare_programs;
compiler_directory_suffix;
@ -128,5 +129,4 @@ let _ = List.iter register_variable
ocamlc_opt_exit_status;
ocamlopt_opt_exit_status;
os_type;
(* source_modules is intentionally not registered *)
]

View File

@ -17,6 +17,8 @@
(* The variables are listed in alphabetical order *)
val all_modules : Variables.t
val c_preprocessor : Variables.t
val compare_programs : Variables.t
@ -64,5 +66,3 @@ val ocamlopt_opt_exit_status : Variables.t
val ocamlsrcdir : Variables.t
val os_type : Variables.t
val source_modules : Variables.t