From f9d482da8899844b194e5d59887daa38e42a01c9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20B=C3=BChler?= <david.buhler@cea.fr>
Date: Fri, 11 Jun 2021 10:12:38 +0200
Subject: [PATCH] [Eva] audit-prepare: catches Json exception in functions
writing the json file.
---
src/kernel_services/ast_queries/file.ml | 15 ++++++---------
src/plugins/value/engine/analysis.ml | 9 +--------
src/plugins/value/utils/eva_audit.ml | 11 ++++++++---
3 files changed, 15 insertions(+), 20 deletions(-)
diff --git a/src/kernel_services/ast_queries/file.ml b/src/kernel_services/ast_queries/file.ml
index e8621a40599..d99085bdc92 100644
--- a/src/kernel_services/ast_queries/file.ml
+++ b/src/kernel_services/ast_queries/file.ml
@@ -1664,7 +1664,11 @@ let print_all_sources out all_sources_tbl =
`Assoc (List.map (fun (f, hash) -> f, `String hash) sorted_elems)
)]
in
- Json.merge_object out json
+ try Json.merge_object out json
+ with Json.CannotMerge _ ->
+ Kernel.abort "%s already computed; it should be set by itself, \
+ after the last '-then' in the command line."
+ Kernel.AuditPrepare.option_name
end
let compute_sources_table cpp_commands =
@@ -1766,14 +1770,7 @@ let prepare_from_c_files () =
let audit_path = Kernel.AuditPrepare.get () in
if not (Filepath.Normalized.is_empty audit_path) then begin
let all_sources_tbl = compute_sources_table cpp_commands in
- begin
- try
- print_all_sources audit_path all_sources_tbl
- with Json.CannotMerge _ ->
- Kernel.abort "%s already computed; it should be set by itself, \
- after the last '-then' in the command line."
- Kernel.AuditPrepare.option_name
- end;
+ print_all_sources audit_path all_sources_tbl;
if not (Filepath.Normalized.is_special_stdout audit_path) then
Kernel.feedback "Audit: sources list written to: %a@."
Filepath.Normalized.pretty audit_path;
diff --git a/src/plugins/value/engine/analysis.ml b/src/plugins/value/engine/analysis.ml
index 5862fe01dff..33c7c3687c5 100644
--- a/src/plugins/value/engine/analysis.ml
+++ b/src/plugins/value/engine/analysis.ml
@@ -176,14 +176,7 @@ let force_compute () =
if not (Kernel.AuditCheck.is_empty ()) then
Eva_audit.check_configuration (Kernel.AuditCheck.get ());
if not (Kernel.AuditPrepare.is_empty ()) then
- begin
- try
- Eva_audit.print_configuration (Kernel.AuditPrepare.get ());
- with Json.CannotMerge _ ->
- Kernel.abort "%s already computed; it should be set by itself, \
- after the last '-then' in the command line."
- Kernel.AuditPrepare.option_name
- end;
+ Eva_audit.print_configuration (Kernel.AuditPrepare.get ());
let kf, lib_entry = Globals.entry_point () in
reset_analyzer ();
let module Analyzer = (val snd !ref_analyzer) in
diff --git a/src/plugins/value/utils/eva_audit.ml b/src/plugins/value/utils/eva_audit.ml
index c376dfe5fca..507125082c3 100644
--- a/src/plugins/value/utils/eva_audit.ml
+++ b/src/plugins/value/utils/eva_audit.ml
@@ -145,6 +145,11 @@ let check_configuration path =
Filepath.Normalized.pretty path msg
let print_configuration path =
- print_correctness_parameters path;
- print_warning_status path "Kernel" (module Kernel);
- print_warning_status path "Eva" (module Value_parameters)
+ try
+ print_correctness_parameters path;
+ print_warning_status path "Kernel" (module Kernel);
+ print_warning_status path "Eva" (module Value_parameters)
+ with Json.CannotMerge _ ->
+ Kernel.abort "%s already computed; it should be set by itself, \
+ after the last '-then' in the command line."
+ Kernel.AuditPrepare.option_name
--
GitLab