Maj terminée. Pour consulter la release notes associée voici le lien :
https://about.gitlab.com/releases/2021/07/07/critical-security-release-gitlab-14-0-4-released/

Une nouvelle version du portail de gestion des comptes externes sera mise en production lundi 09 août. Elle permettra d'allonger la validité d'un compte externe jusqu'à 3 ans. Pour plus de détails sur cette version consulter : https://doc-si.inria.fr/x/FCeS

Commit fe2ca9c0 authored by Jean-Christophe Filliâtre's avatar Jean-Christophe Filliâtre
Browse files

new prover option in_place to run the verification on the original file

the original file is properly saved and restored upon completion
(whatever the result is)
parent 7d199db8
...@@ -354,6 +354,7 @@ version_regexp = "PVS Version \\([^ \n]+\\)" ...@@ -354,6 +354,7 @@ version_regexp = "PVS Version \\([^ \n]+\\)"
version_ok = "5.0" version_ok = "5.0"
command = "'@LOCALBIN@why3-cpulimit' 0 %m -s @LOCALBIN@why3-check-pvs %l %f" command = "'@LOCALBIN@why3-cpulimit' 0 %m -s @LOCALBIN@why3-check-pvs %l %f"
driver = "drivers/pvs.drv" driver = "drivers/pvs.drv"
in_place = true
editor = "pvs" editor = "pvs"
[editor pvs] [editor pvs]
......
...@@ -80,7 +80,7 @@ let rec goal whyconf env path dbgoal wgoal = ...@@ -80,7 +80,7 @@ let rec goal whyconf env path dbgoal wgoal =
let old = if edited_as = "" then None else let old = if edited_as = "" then None else
begin begin
eprintf "Info: proving using edited file %s@." edited_as; eprintf "Info: proving using edited file %s@." edited_as;
(Some (open_in edited_as)) (Some edited_as)
end end
in in
let call_prover : Call_provers.pre_prover_call = let call_prover : Call_provers.pre_prover_call =
......
...@@ -42,6 +42,7 @@ type prover_autodetection_data = ...@@ -42,6 +42,7 @@ type prover_autodetection_data =
prover_command : string; prover_command : string;
prover_driver : string; prover_driver : string;
prover_editor : string; prover_editor : string;
prover_in_place : bool;
} }
let prover_keys = let prover_keys =
...@@ -49,7 +50,7 @@ let prover_keys = ...@@ -49,7 +50,7 @@ let prover_keys =
List.fold_left add Sstr.empty List.fold_left add Sstr.empty
["name";"exec";"version_switch";"version_regexp"; ["name";"exec";"version_switch";"version_regexp";
"version_ok";"version_old";"version_bad";"command"; "version_ok";"version_old";"version_bad";"command";
"editor";"driver"] "editor";"driver";"in_place"]
let load_prover kind (id,section) = let load_prover kind (id,section) =
check_exhaustive section prover_keys; check_exhaustive section prover_keys;
...@@ -65,6 +66,7 @@ let load_prover kind (id,section) = ...@@ -65,6 +66,7 @@ let load_prover kind (id,section) =
prover_command = get_string section "command"; prover_command = get_string section "command";
prover_driver = get_string section "driver"; prover_driver = get_string section "driver";
prover_editor = get_string section ~default:"" "editor"; prover_editor = get_string section ~default:"" "editor";
prover_in_place = get_bool section ~default:false "in_place";
} }
let editor_keys = let editor_keys =
...@@ -187,6 +189,7 @@ let detect_exec main data com = ...@@ -187,6 +189,7 @@ let detect_exec main data com =
command = c; command = c;
driver = Filename.concat (datadir main) data.prover_driver; driver = Filename.concat (datadir main) data.prover_driver;
editor = data.prover_editor; editor = data.prover_editor;
in_place = data.prover_in_place;
interactive = (match data.kind with ITP -> true | ATP -> false); interactive = (match data.kind with ITP -> true | ATP -> false);
extra_options = []; extra_options = [];
extra_drivers = [] } extra_drivers = [] }
......
...@@ -128,9 +128,11 @@ type post_prover_call = unit -> prover_result ...@@ -128,9 +128,11 @@ type post_prover_call = unit -> prover_result
type prover_call = Unix.wait_flag list -> post_prover_call type prover_call = Unix.wait_flag list -> post_prover_call
type pre_prover_call = unit -> prover_call type pre_prover_call = unit -> prover_call
let save f = f ^ ".save"
let call_on_file ~command ?(timelimit=0) ?(memlimit=0) let call_on_file ~command ?(timelimit=0) ?(memlimit=0)
~regexps ~timeregexps ~exitcodes ~regexps ~timeregexps ~exitcodes
?(cleanup=false) fin = ?(cleanup=false) ?(inplace=false) fin =
let arglist = Cmdline.cmdline_split command in let arglist = Cmdline.cmdline_split command in
let command = List.hd arglist in let command = List.hd arglist in
...@@ -150,8 +152,12 @@ let call_on_file ~command ?(timelimit=0) ?(memlimit=0) ...@@ -150,8 +152,12 @@ let call_on_file ~command ?(timelimit=0) ?(memlimit=0)
| _ -> failwith "unknown specifier, use %%f, %%t, %%m, %%l, or %%d" | _ -> failwith "unknown specifier, use %%f, %%t, %%m, %%l, or %%d"
in in
let subst s = let subst s =
try Str.global_substitute cmd_regexp replace s try
with e -> if cleanup then Sys.remove fin; raise e Str.global_substitute cmd_regexp replace s
with e ->
if cleanup then Sys.remove fin;
if inplace then Sys.rename (save fin) fin;
raise e
in in
let arglist = List.map subst arglist in let arglist = List.map subst arglist in
Debug.dprintf debug "@[<hov 2>Call_provers: command is: %a@]@." Debug.dprintf debug "@[<hov 2>Call_provers: command is: %a@]@."
...@@ -179,6 +185,7 @@ let call_on_file ~command ?(timelimit=0) ?(memlimit=0) ...@@ -179,6 +185,7 @@ let call_on_file ~command ?(timelimit=0) ?(memlimit=0)
fun () -> fun () ->
if Debug.nottest_flag debug then begin if Debug.nottest_flag debug then begin
if cleanup then Sys.remove fin; if cleanup then Sys.remove fin;
if inplace then Sys.rename (save fin) fin;
Sys.remove fout Sys.remove fout
end; end;
let ans = match ret with let ans = match ret with
...@@ -205,12 +212,18 @@ let call_on_file ~command ?(timelimit=0) ?(memlimit=0) ...@@ -205,12 +212,18 @@ let call_on_file ~command ?(timelimit=0) ?(memlimit=0)
pr_time = time } pr_time = time }
let call_on_buffer ~command ?(timelimit=0) ?(memlimit=0) let call_on_buffer ~command ?(timelimit=0) ?(memlimit=0)
~regexps ~timeregexps ~exitcodes ~filename buffer = ~regexps ~timeregexps ~exitcodes ~filename
?(inplace=false) buffer =
let fin,cin = Filename.open_temp_file "why_" ("_" ^ filename) in
let fin,cin =
if inplace then begin
Sys.rename filename (save filename);
filename, open_out filename
end else
Filename.open_temp_file "why_" ("_" ^ filename) in
Buffer.output_buffer cin buffer; close_out cin; Buffer.output_buffer cin buffer; close_out cin;
call_on_file ~command ~timelimit ~memlimit call_on_file ~command ~timelimit ~memlimit
~regexps ~timeregexps ~exitcodes ~cleanup:true fin ~regexps ~timeregexps ~exitcodes ~cleanup:true ~inplace fin
let query_call call = try Some (call [Unix.WNOHANG]) with Exit -> None let query_call call = try Some (call [Unix.WNOHANG]) with Exit -> None
......
...@@ -85,6 +85,7 @@ val call_on_file : ...@@ -85,6 +85,7 @@ val call_on_file :
timeregexps : timeregexp list -> timeregexps : timeregexp list ->
exitcodes : (int * prover_answer) list -> exitcodes : (int * prover_answer) list ->
?cleanup : bool -> ?cleanup : bool ->
?inplace : bool ->
string -> pre_prover_call string -> pre_prover_call
val call_on_buffer : val call_on_buffer :
...@@ -95,6 +96,7 @@ val call_on_buffer : ...@@ -95,6 +96,7 @@ val call_on_buffer :
timeregexps : timeregexp list -> timeregexps : timeregexp list ->
exitcodes : (int * prover_answer) list -> exitcodes : (int * prover_answer) list ->
filename : string -> filename : string ->
?inplace : bool ->
Buffer.t -> pre_prover_call Buffer.t -> pre_prover_call
(** Call a prover on the task printed in the {!type: Buffer.t} given. (** Call a prover on the task printed in the {!type: Buffer.t} given.
......
...@@ -227,13 +227,13 @@ let file_of_task drv input_file theory_name task = ...@@ -227,13 +227,13 @@ let file_of_task drv input_file theory_name task =
let file_of_theory drv input_file th = let file_of_theory drv input_file th =
get_filename drv input_file th.th_name.Ident.id_string "null" get_filename drv input_file th.th_name.Ident.id_string "null"
let call_on_buffer ~command ?timelimit ?memlimit ~filename drv buffer = let call_on_buffer ~command ?timelimit ?memlimit ?inplace ~filename drv buffer =
let regexps = drv.drv_regexps in let regexps = drv.drv_regexps in
let timeregexps = drv.drv_timeregexps in let timeregexps = drv.drv_timeregexps in
let exitcodes = drv.drv_exitcodes in let exitcodes = drv.drv_exitcodes in
Call_provers.call_on_buffer Call_provers.call_on_buffer
~command ?timelimit ?memlimit ~regexps ~timeregexps ~command ?timelimit ?memlimit ~regexps ~timeregexps
~exitcodes ~filename buffer ~exitcodes ~filename ?inplace buffer
(** print'n'prove *) (** print'n'prove *)
...@@ -300,25 +300,31 @@ let print_theory ?old drv fmt th = ...@@ -300,25 +300,31 @@ let print_theory ?old drv fmt th =
let task = Task.use_export None th in let task = Task.use_export None th in
print_task ?old drv fmt task print_task ?old drv fmt task
let prove_task_prepared ~command ?timelimit ?memlimit ?old drv task = let prove_task_prepared
~command ?timelimit ?memlimit ?old ?inplace drv task =
let buf = Buffer.create 1024 in let buf = Buffer.create 1024 in
let fmt = formatter_of_buffer buf in let fmt = formatter_of_buffer buf in
print_task_prepared ?old drv fmt task; pp_print_flush fmt (); let old_channel = option_map open_in old in
let filename = print_task_prepared ?old:old_channel drv fmt task; pp_print_flush fmt ();
let pr = Task.task_goal task in option_iter close_in old_channel;
let fn = match pr.pr_name.id_loc with let filename = match old, inplace with
| Some loc -> let fn,_,_,_ = Loc.get loc in Filename.basename fn | Some fn, Some true -> fn
| None -> "" in | _ ->
let fn = try Filename.chop_extension fn with Invalid_argument _ -> fn in let pr = Task.task_goal task in
get_filename drv fn "T" pr.pr_name.id_string let fn = match pr.pr_name.id_loc with
| Some loc -> let fn,_,_,_ = Loc.get loc in Filename.basename fn
| None -> "" in
let fn = try Filename.chop_extension fn with Invalid_argument _ -> fn in
get_filename drv fn "T" pr.pr_name.id_string
in in
let res = call_on_buffer ~command ?timelimit ?memlimit ~filename drv buf in let res =
call_on_buffer ~command ?timelimit ?memlimit ?inplace ~filename drv buf in
Buffer.reset buf; Buffer.reset buf;
res res
let prove_task ~command ?timelimit ?memlimit ?old drv task = let prove_task ~command ?timelimit ?memlimit ?old ?inplace drv task =
let task = prepare_task drv task in let task = prepare_task drv task in
prove_task_prepared ~command ?timelimit ?memlimit ?old drv task prove_task_prepared ~command ?timelimit ?memlimit ?old ?inplace drv task
(* exception report *) (* exception report *)
......
...@@ -47,6 +47,7 @@ val call_on_buffer : ...@@ -47,6 +47,7 @@ val call_on_buffer :
command : string -> command : string ->
?timelimit : int -> ?timelimit : int ->
?memlimit : int -> ?memlimit : int ->
?inplace : bool ->
filename : string -> filename : string ->
driver -> Buffer.t -> Call_provers.pre_prover_call driver -> Buffer.t -> Call_provers.pre_prover_call
...@@ -64,7 +65,8 @@ val prove_task : ...@@ -64,7 +65,8 @@ val prove_task :
command : string -> command : string ->
?timelimit : int -> ?timelimit : int ->
?memlimit : int -> ?memlimit : int ->
?old : in_channel -> ?old : string ->
?inplace : bool ->
driver -> Task.task -> Call_provers.pre_prover_call driver -> Task.task -> Call_provers.pre_prover_call
(** Split the previous function in two simpler functions *) (** Split the previous function in two simpler functions *)
...@@ -78,6 +80,7 @@ val prove_task_prepared : ...@@ -78,6 +80,7 @@ val prove_task_prepared :
command : string -> command : string ->
?timelimit : int -> ?timelimit : int ->
?memlimit : int -> ?memlimit : int ->
?old : in_channel -> ?old : string ->
?inplace : bool ->
driver -> Task.task -> Call_provers.pre_prover_call driver -> Task.task -> Call_provers.pre_prover_call
...@@ -113,6 +113,7 @@ type config_prover = { ...@@ -113,6 +113,7 @@ type config_prover = {
id : string; id : string;
command : string; command : string;
driver : string; driver : string;
in_place: bool;
editor : string; editor : string;
interactive : bool; interactive : bool;
extra_options : string list; extra_options : string list;
...@@ -236,6 +237,7 @@ let set_prover _ prover (ids,family) = ...@@ -236,6 +237,7 @@ let set_prover _ prover (ids,family) =
let section = set_string ~default:"" section "alternative" prover.prover.prover_altern in let section = set_string ~default:"" section "alternative" prover.prover.prover_altern in
let section = set_string section "editor" prover.editor in let section = set_string section "editor" prover.editor in
let section = set_bool section "interactive" prover.interactive in let section = set_bool section "interactive" prover.interactive in
let section = set_bool section "in_place" prover.in_place in
(Sstr.add prover.id ids,(prover.id,section)::family) (Sstr.add prover.id ids,(prover.id,section)::family)
let set_provers rc provers = let set_provers rc provers =
...@@ -298,6 +300,7 @@ let load_prover dirname provers (id,section) = ...@@ -298,6 +300,7 @@ let load_prover dirname provers (id,section) =
prover = prover; prover = prover;
command = get_string section "command"; command = get_string section "command";
driver = absolute_filename dirname (get_string section "driver"); driver = absolute_filename dirname (get_string section "driver");
in_place = get_bool ~default:false section "in_place";
editor = get_string ~default:"" section "editor"; editor = get_string ~default:"" section "editor";
interactive = get_bool ~default:false section "interactive"; interactive = get_bool ~default:false section "interactive";
extra_options = []; extra_options = [];
......
...@@ -109,6 +109,7 @@ type config_prover = { ...@@ -109,6 +109,7 @@ type config_prover = {
id : string; (* unique name for command line *) id : string; (* unique name for command line *)
command : string; (* "exec why-limit %t %m alt-ergo %f" *) command : string; (* "exec why-limit %t %m alt-ergo %f" *)
driver : string; (* "/usr/local/share/why/drivers/ergo-spec.drv" *) driver : string; (* "/usr/local/share/why/drivers/ergo-spec.drv" *)
in_place: bool; (* verification should be performed in-place *)
editor : string; (* Dedicated editor *) editor : string; (* Dedicated editor *)
interactive : bool; (* Interactive theorem prover *) interactive : bool; (* Interactive theorem prover *)
extra_options : string list; extra_options : string list;
......
...@@ -93,7 +93,7 @@ let running a = match a.proof_state with ...@@ -93,7 +93,7 @@ let running a = match a.proof_state with
(*************************) (*************************)
type action = type action =
| Action_proof_attempt of int * int * in_channel option * string * | Action_proof_attempt of int * int * string option * bool * string *
Driver.driver * (proof_attempt_status -> unit) * Task.task Driver.driver * (proof_attempt_status -> unit) * Task.task
| Action_delayed of (unit -> unit) | Action_delayed of (unit -> unit)
...@@ -218,14 +218,14 @@ let idle_handler t = ...@@ -218,14 +218,14 @@ let idle_handler t =
try try
begin begin
match Queue.pop t.actions_queue with match Queue.pop t.actions_queue with
| Action_proof_attempt(timelimit,memlimit,old,command,driver, | Action_proof_attempt(timelimit,memlimit,old,inplace,command,driver,
callback,goal) -> callback,goal) ->
callback (Undone Scheduled); callback (Undone Scheduled);
begin begin
try try
let pre_call = let pre_call =
Driver.prove_task Driver.prove_task
?old ~command ~timelimit ~memlimit driver goal ?old ~inplace ~command ~timelimit ~memlimit driver goal
in in
Queue.push (callback,pre_call) t.proof_attempts_queue; Queue.push (callback,pre_call) t.proof_attempts_queue;
run_timeout_handler t run_timeout_handler t
...@@ -264,7 +264,7 @@ let cancel_scheduled_proofs t = ...@@ -264,7 +264,7 @@ let cancel_scheduled_proofs t =
try try
while true do while true do
match Queue.pop t.actions_queue with match Queue.pop t.actions_queue with
| Action_proof_attempt(_timelimit,_memlimit,_old,_command, | Action_proof_attempt(_timelimit,_memlimit,_old,_inplace,_command,
_driver,callback,_goal) -> _driver,callback,_goal) ->
callback (Undone Interrupted) callback (Undone Interrupted)
| Action_delayed _ as a-> | Action_delayed _ as a->
...@@ -282,13 +282,13 @@ let cancel_scheduled_proofs t = ...@@ -282,13 +282,13 @@ let cancel_scheduled_proofs t =
O.notify_timer_state 0 0 (List.length t.running_proofs) O.notify_timer_state 0 0 (List.length t.running_proofs)
let schedule_proof_attempt ~timelimit ~memlimit ?old let schedule_proof_attempt ~timelimit ~memlimit ?old ~inplace
~command ~driver ~callback t goal = ~command ~driver ~callback t goal =
dprintf debug "[Sched] Scheduling a new proof attempt (goal : %a)@." dprintf debug "[Sched] Scheduling a new proof attempt (goal : %a)@."
(fun fmt g -> Format.pp_print_string fmt (fun fmt g -> Format.pp_print_string fmt
(Task.task_goal g).Decl.pr_name.Ident.id_string) goal; (Task.task_goal g).Decl.pr_name.Ident.id_string) goal;
Queue.push Queue.push
(Action_proof_attempt(timelimit,memlimit,old,command,driver, (Action_proof_attempt(timelimit,memlimit,old,inplace,command,driver,
callback,goal)) callback,goal))
t.actions_queue; t.actions_queue;
run_idle_handler t run_idle_handler t
...@@ -475,20 +475,21 @@ let run_external_proof eS eT ?callback a = ...@@ -475,20 +475,21 @@ let run_external_proof eS eT ?callback a =
| Some f -> | Some f ->
if Sys.file_exists f then begin if Sys.file_exists f then begin
dprintf debug "Info: proving using edited file %s@." f; dprintf debug "Info: proving using edited file %s@." f;
(Some (open_in f)) (Some f)
end end
else begin else begin
dprintf debug "Warning: the file %s is not found@." f; dprintf debug "Warning: the file %s is not found@." f;
None None
end end
in in
let inplace = npc.prover_config.Whyconf.in_place in
let command = let command =
String.concat " " (npc.prover_config.Whyconf.command :: String.concat " " (npc.prover_config.Whyconf.command ::
npc.prover_config.Whyconf.extra_options) in npc.prover_config.Whyconf.extra_options) in
(* eprintf "scheduling it...@."; *) (* eprintf "scheduling it...@."; *)
schedule_proof_attempt schedule_proof_attempt
~timelimit ~memlimit ~timelimit ~memlimit
?old ~command ?old ~inplace ~command
~driver:npc.prover_driver ~driver:npc.prover_driver
~callback ~callback
eT eT
...@@ -677,11 +678,12 @@ let check_external_proof eS eT todo a = ...@@ -677,11 +678,12 @@ let check_external_proof eS eT todo a =
if Sys.file_exists f then if Sys.file_exists f then
begin begin
(* Format.eprintf "Info: proving using edited file %s@." f; *) (* Format.eprintf "Info: proving using edited file %s@." f; *)
(Some (open_in f)) (Some f)
end end
else else
raise (NoFile f) raise (NoFile f)
in in
let inplace = npc.prover_config.Whyconf.in_place in
let timelimit = adapt_timelimit a in let timelimit = adapt_timelimit a in
let memlimit = a.proof_memlimit in let memlimit = a.proof_memlimit in
let callback result = let callback result =
...@@ -710,7 +712,7 @@ let check_external_proof eS eT todo a = ...@@ -710,7 +712,7 @@ let check_external_proof eS eT todo a =
npc.prover_config.Whyconf.extra_options) in npc.prover_config.Whyconf.extra_options) in
schedule_proof_attempt eT schedule_proof_attempt eT
~timelimit ~memlimit ~timelimit ~memlimit
?old ~command ?old ~inplace ~command
~driver:npc.prover_driver ~driver:npc.prover_driver
~callback ~callback
(goal_task g) (goal_task g)
......
theory T theory T
type t = None | Some int use import int.Int
goal G: forall x: t. x <> None -> goal G: 1+3 > 2
match x with None -> false | Some z -> z = 0 end
end end
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment