From 88eddcbb186a7449e70c5c170e3b04b416c9f86b Mon Sep 17 00:00:00 2001
From: Erwan Jahier <erwan.jahier@univ-grenoble-alpes.fr>
Date: Thu, 12 Mar 2020 17:41:39 +0100
Subject: [PATCH] fix: exit with a gentle message whe the algo firls is empty
---
lib/sasacore/main.ml | 62 +++++++++++++++++++++++---------------------
1 file changed, 33 insertions(+), 29 deletions(-)
diff --git a/lib/sasacore/main.ml b/lib/sasacore/main.ml
index 0ea29b1b..a8da7522 100644
--- a/lib/sasacore/main.ml
+++ b/lib/sasacore/main.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 06/03/2020 (at 13:22) by Erwan Jahier> *)
+(* Time-stamp: <modified the 12/03/2020 (at 16:55) by Erwan Jahier> *)
open Register
@@ -152,7 +152,7 @@ let (get_outputs_rif_decl: SasArg.t -> 'v Process.t list -> (string * string) li
let vars =
List.fold_left
(fun acc p ->
- let l = SasaState.to_rif_decl p.pid p.init in
+ let l = List.rev (SasaState.to_rif_decl p.pid p.init) in
List.fold_left (fun acc (n,t) -> (n, Data.type_to_string t)::acc) acc l
)
vars
@@ -171,15 +171,15 @@ let (make : bool -> string array -> 'v t) =
fun dynlink argv ->
let args =
try SasArg.parse argv;
- with
- Failure(e) ->
- output_string stdout e;
- flush stdout ;
- exit 2
- | e ->
- output_string stdout (Printexc.to_string e);
- flush stdout;
- exit 2
+ with
+ Failure(e) ->
+ output_string stdout e;
+ flush stdout ;
+ exit 2
+ | e ->
+ output_string stdout (Printexc.to_string e);
+ flush stdout;
+ exit 2
in
try
let dynlink = if args.output_algos then false else dynlink in
@@ -221,7 +221,7 @@ let (make : bool -> string array -> 'v t) =
Register.set_is_directed (fun () -> g.directed);
Register.verbose_level := args.verbose;
-
+
if !Register.verbose_level > 1 then Printf.eprintf "==> nodes: %s\n" nstr;
if dynlink then (
@@ -232,16 +232,20 @@ let (make : bool -> string array -> 'v t) =
) else ();
let initl = List.map (fun n ->
- let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
- let value_of_string_opt = Register.get_value_of_string () in
- if value_of_string_opt = None || n.Topology.init = "" then
- Register.get_init_state algo_id (List.length (g.succ n.id)) n.id
- else
- match value_of_string_opt with
- | None -> assert false (* sno *)
- | Some f -> f n.Topology.init
- )
- nl
+ if n.Topology.file = "" then (
+ Printf.eprintf " [sasa] Empty algo attribute in %s.\n%!" dot_file;
+ exit 1
+ );
+ let algo_id = Filename.chop_suffix n.Topology.file ".ml" in
+ let value_of_string_opt = Register.get_value_of_string () in
+ if value_of_string_opt = None || n.Topology.init = "" then
+ Register.get_init_state algo_id (List.length (g.succ n.id)) n.id
+ else
+ match value_of_string_opt with
+ | None -> assert false (* sno *)
+ | Some f -> f n.Topology.init
+ )
+ nl
in
if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n";
@@ -303,11 +307,11 @@ let (make : bool -> string array -> 'v t) =
args, pl_n, e
with
| Dynlink.Error e ->
- Printf.eprintf " [sasa] Error when dynlinking (Sasacore.make): %s\n%!"
- (Dynlink.error_message e);
- flush_all();
- exit 2
+ Printf.eprintf " [sasa] Error when dynlinking (Sasacore.make): %s\n%!"
+ (Dynlink.error_message e);
+ flush_all();
+ exit 2
| e ->
- Printf.eprintf " [sasa] Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
- flush_all();
- exit 2
+ Printf.eprintf " [sasa] Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
+ flush_all();
+ exit 2
--
GitLab