Commit 37ac48f4f3e8b9bcfa5a38590eb04cd2cfae669d

Authored by Jan Lupa
1 parent eea52de2

Error-proofing updates to interactive Concraft, and Świgra.

tools/concraft/concraft_test.ml
  1 +let concraft_exists () =
  2 + let check_in, check_out, check_err = Unix.open_process_full ("command -v concraft-pl")
  3 + [|"PATH=" ^ Sys.getenv "PATH"; "LANG=en_GB.UTF-8"|] in
  4 + let close_check () = Unix.close_process_full (check_in, check_out, check_err) in
  5 + try
  6 + ignore @@ input_line check_in;
  7 + ignore @@ close_check ();
  8 + true
  9 + with End_of_file -> ignore @@ close_check (); false
  10 +
1 11 let wait_for_server () =
2 12 let rec wait s a =
3 13 try Unix.connect s a
4   - with _ -> Unix.sleep 1; wait s a in
  14 + with e -> Unix.sleep 1; wait s a in
5 15 let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 6 in
6 16 let a = Unix.ADDR_INET (Unix.inet_addr_loopback, 10089) in
7 17 wait s a;
8 18 Unix.shutdown s Unix.SHUTDOWN_SEND;
9 19 Unix.close s
10 20  
11   -let start_server () =
  21 +let start_server m =
12 22 let client_out, server_out = Unix.pipe () in
13 23 let client_err, server_err = Unix.pipe () in
14   - let pid = Unix.create_process "concraft-pl" [|"concraft-pl"; "server"; "--inmodel"; "nkjp-model-0.2.gz"|]
  24 + let pid = Unix.create_process "concraft-pl" [|"concraft-pl"; "server"; "--inmodel"; m|]
15 25 Unix.stdin server_out server_err in
16 26 List.iter Unix.close [client_out; server_out; client_err; server_err];
17 27 wait_for_server ();
... ... @@ -25,17 +35,26 @@ let tag s =
25 35 [|"PATH=" ^ Sys.getenv "PATH"; "LANG=en_GB.UTF-8"|]
26 36  
27 37 let _ =
28   - let pid = start_server () in
29   - let concraft_in, concraft_out, concraft_err = tag "Ala ma kota." in
30   - try
31   - while true do
32   - print_endline @@ input_line concraft_in
33   - done
34   - with End_of_file -> ();
35   - try
36   - while true do
37   - print_endline @@ "concraft error message: " ^ input_line concraft_err
38   - done
39   - with End_of_file -> ();
40   - ignore @@ Unix.close_process_full (concraft_in, concraft_out, concraft_err);
41   - stop_server pid
  38 + if not @@ concraft_exists () then
  39 + print_endline "Error: The command concraft-pl is missing. Please make sure Concraft is installed properly."
  40 + else if Array.length @@ Sys.argv < 2 then
  41 + print_endline "Usage: concraft_test <model_file>"
  42 + else if not @@ Sys.file_exists Sys.argv.(1) then
  43 + print_endline "Error: The provided model file does not exist."
  44 + else
  45 + (
  46 + let pid = start_server @@ Sys.argv.(1) in
  47 + let concraft_in, concraft_out, concraft_err = tag "Ala ma kota." in
  48 + try
  49 + while true do
  50 + print_endline @@ input_line concraft_in
  51 + done
  52 + with End_of_file -> ();
  53 + try
  54 + while true do
  55 + print_endline @@ "concraft error message: " ^ input_line concraft_err
  56 + done
  57 + with End_of_file -> ();
  58 + ignore @@ Unix.close_process_full (concraft_in, concraft_out, concraft_err);
  59 + stop_server pid
  60 + )
... ...
tools/swigra/parser/swigra_test.ml
1   -let start_server () =
2   - let serv_in, serv_out, serv_err = Unix.open_process_full "./swigra -w"
  1 +let start_server dir =
  2 + let serv_in, serv_out, serv_err = Unix.open_process_full ("cd " ^ dir ^ "; ./swigra -w")
3 3 [|"PATH=" ^ Sys.getenv "PATH"; "LANG=en_GB.UTF-8"|] in
4 4 ignore @@ input_line serv_in;
5 5 serv_in, serv_out, serv_err
... ... @@ -17,8 +17,8 @@ let curl s =
17 17 done
18 18 with End_of_file -> ignore @@ Unix.close_process_full (curl_in, curl_out, curl_err)
19 19  
20   -let print_xml () =
21   - let xml_in = open_in "httpd/forest-disamb.xml" in
  20 +let print_xml dir =
  21 + let xml_in = open_in @@ dir ^ "/httpd/forest-disamb.xml" in
22 22 try
23 23 while true do
24 24 print_endline @@ input_line xml_in
... ... @@ -26,9 +26,17 @@ let print_xml () =
26 26 with End_of_file -> close_in xml_in
27 27  
28 28 let _ =
29   - let server = start_server () in
30   - curl "Ala ma kota.";
31   - print_xml ();
32   - curl "Ala ma psa.";
33   - print_xml ();
34   - stop_server server
  29 + if Array.length @@ Sys.argv < 2 then
  30 + print_endline "Usage: swigra_test <swigra_directory>"
  31 + else if (not @@ Sys.file_exists Sys.argv.(1)) || (not @@ Sys.is_directory Sys.argv.(1)) then
  32 + print_endline "Error: The provided directory does not exist."
  33 + else
  34 + (
  35 + let dir = Sys.argv.(1) in
  36 + let server = start_server dir in
  37 + curl "Ala ma kota.";
  38 + print_xml dir;
  39 + curl "Ala ma psa.";
  40 + print_xml dir;
  41 + stop_server server
  42 + )
... ...