Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Why3
why3
Commits
c6dc4315
Commit
c6dc4315
authored
Apr 09, 2012
by
MARCHE Claude
Browse files
Again, fixed mistakes related to the timelimit used
when replaying proofs.
parent
66f56097
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/driver/call_provers.ml
View file @
c6dc4315
...
...
@@ -86,6 +86,8 @@ let print_prover_answer fmt = function
|
Valid
->
fprintf
fmt
"Valid"
|
Invalid
->
fprintf
fmt
"Invalid"
|
Timeout
->
fprintf
fmt
"Timeout"
|
Unknown
""
->
fprintf
fmt
"Unknown"
|
Failure
""
->
fprintf
fmt
"Failure"
|
Unknown
s
->
fprintf
fmt
"Unknown: %s"
s
|
Failure
s
->
fprintf
fmt
"Failure: %s"
s
|
HighFailure
->
fprintf
fmt
"HighFailure"
...
...
src/ide/replay.ml
View file @
c6dc4315
...
...
@@ -210,19 +210,22 @@ end
module
M
=
Session_scheduler
.
Make
(
O
)
let
print_result
fmt
{
Call_provers
.
pr_answer
=
ans
;
Call_provers
.
pr_output
=
out
;
Call_provers
.
pr_
time
=_
t
}
=
(*
{
Call_provers
.
pr_answer
=
ans
;
Call_provers
.
pr_
output
=
out
;
Call_provers
.
pr_time
=
t
}
=
fprintf
fmt
"%a (%.1fs)"
Call_provers
.
print_prover_answer
ans
t
;
*
)
(
*
fprintf fmt "%a" Call_provers.print_prover_answer ans;
if
ans
==
Call_provers
.
HighFailure
then
fprintf
fmt
"@
\n
Prover output:@
\n
%s@."
out
*)
match
ans
with
|
Call_provers
.
HighFailure
->
fprintf
fmt
"@
\n
Prover output:@
\n
%s@."
out
|
_
->
()
(*
fprintf fmt "[limit=%s@\nProver output:@\n%s@." out
*)
let
main_loop
=
O
.
main_loop
(*
let model_index = Hashtbl.create 257
*)
let
project_dir
=
try
...
...
@@ -262,14 +265,14 @@ let print_statistics files =
List
.
iter
print_file
(
List
.
rev
files
)
let
print_report
(
g
,
p
,
r
)
=
let
print_report
(
g
,
p
,
t
,
r
)
=
printf
" goal '%s', prover '%a': "
g
.
Ident
.
id_string
Whyconf
.
print_prover
p
;
match
r
with
|
M
.
Result
(
new_res
,
old_res
)
->
(* begin match !opt_smoke with *)
(* | Session.SD_None -> *)
printf
"%a instead of %a@."
print_result
new_res
print_result
old_res
printf
"%a instead of %a
(timelimit=%d)
@."
print_result
new_res
print_result
old_res
t
(* | _ -> *)
(* printf "Smoke detected!!!@." *)
(* end *)
...
...
@@ -298,9 +301,14 @@ let add_to_check_no_smoke config found_obs env_session sched =
S
.
PHstr
.
fold
file_statistics
session
.
S
.
session_files
([]
,
0
,
0
)
in
let
report
=
List
.
filter
(
function
|
(
_
,_,
M
.
Result
(
new_res
,
old_res
))
->
not
(
same_result
new_res
old_res
)
|
_
->
true
)
report
in
let
report
=
List
.
filter
(
function
|
(
_
,_,_,
M
.
Result
(
new_res
,
old_res
))
->
not
(
same_result
new_res
old_res
)
|
_
->
true
)
report
in
if
report
=
[]
then
begin
if
found_obs
then
if
n
=
m
then
...
...
@@ -338,12 +346,15 @@ session NOT updated)@." n m
let
add_to_check_smoke
env_session
sched
=
let
callback
report
=
eprintf
"@."
;
let
report
=
List
.
filter
(
function
|
(
_
,_,
M
.
Result
({
Call_provers
.
pr_answer
=
Call_provers
.
Valid
}
,_
))
->
true
|
(
_
,_,
M
.
No_former_result
({
Call_provers
.
pr_answer
=
Call_provers
.
Valid
}))
->
true
|
_
->
false
)
report
in
let
report
=
List
.
filter
(
function
|
(
_
,_,_,
M
.
Result
({
Call_provers
.
pr_answer
=
Call_provers
.
Valid
}
,_
))
->
true
|
(
_
,_,_,
M
.
No_former_result
({
Call_provers
.
pr_answer
=
Call_provers
.
Valid
}))
->
true
|
_
->
false
)
report
in
if
report
=
[]
then
begin
eprintf
"No smoke detected.@."
;
exit
0
...
...
@@ -376,26 +387,15 @@ let run_as_bench env_session =
M
.
init
(
Whyconf
.
running_provers_max
(
Whyconf
.
get_main
config
))
in
eprintf
"Provers:@ "
;
let
provers
=
let
provers
=
Whyconf
.
Mprover
.
fold
(
fun
_
p
acc
->
(
fun
_
p
acc
->
if
p
.
Whyconf
.
interactive
then
acc
else
begin
eprintf
"%a@ "
Whyconf
.
print_prover
p
.
Whyconf
.
prover
;
p
.
Whyconf
.
prover
::
acc
end
)
(
Whyconf
.
get_provers
env_session
.
Session
.
whyconf
)
[]
(*
Session.PHprover.fold
(fun _ p acc ->
match p with
| None -> acc
| Some p ->
let p = p.Session.prover_config.Whyconf.prover in
eprintf "prover: %a@." Whyconf.print_prover p;
p :: acc)
env_session.Session.loaded_provers []
*)
in
eprintf
"@."
;
let
callback
()
=
...
...
@@ -405,8 +405,8 @@ let run_as_bench env_session =
exit
0
in
M
.
play_all
env_session
sched
~
callback
~
timelimit
:
2
provers
;
main_loop
()
;
eprintf
"main replayer (in bench mode) exited unexpectedly@."
;
main_loop
()
;
eprintf
"main replayer (in bench mode) exited unexpectedly@."
;
exit
1
let
()
=
...
...
@@ -433,8 +433,8 @@ let () =
(* M.smoke_detector := !opt_smoke; *)
eprintf
" done."
;
add_to_check
config
found_obs
env_session
sched
;
main_loop
()
;
eprintf
"main replayer exited unexpectedly@."
;
main_loop
()
;
eprintf
"main replayer exited unexpectedly@."
;
exit
1
with
|
S
.
OutdatedSession
->
...
...
src/session/session_scheduler.ml
View file @
c6dc4315
...
...
@@ -272,7 +272,7 @@ let cancel_scheduled_proofs t =
callback
(
Undone
Interrupted
)
done
with
|
Queue
.
Empty
->
|
Queue
.
Empty
->
O
.
notify_timer_state
0
0
(
List
.
length
t
.
running_proofs
)
...
...
@@ -334,6 +334,15 @@ let rec find_loadable_prover eS prover =
end
|
Some
npc
->
Some
(
prover
,
npc
)
let
adapt_timelimit
a
=
match
a
.
proof_state
with
|
Done
{
Call_provers
.
pr_answer
=
Call_provers
.
Valid
;
Call_provers
.
pr_time
=
t
}
->
let
time
=
max
a
.
proof_timelimit
(
1
+
truncate
(
2
.
0
*.
t
))
in
set_timelimit
time
a
;
time
|
_
->
a
.
proof_timelimit
let
run_external_proof
eS
eT
?
callback
a
=
(** Perhaps this test, a.proof_archived, should be done somewhere else *)
...
...
@@ -343,11 +352,11 @@ let run_external_proof eS eT ?callback a =
(* info_window `ERROR "Proof already in progress" *)
let
ap
=
a
.
proof_prover
in
match
find_loadable_prover
eS
a
.
proof_prover
with
|
None
->
|
None
->
Debug
.
dprintf
debug
"[Info] Can't redo an external proof since the prover %a is not loaded@."
Whyconf
.
print_prover
a
.
proof_prover
;
Util
.
apply_option2
()
callback
a
a
.
proof_state
Util
.
apply_option2
()
callback
a
a
.
proof_state
|
Some
(
nap
,
npc
)
->
(* eprintf "prover %a on goal %s@." *)
(* Whyconf.print_prover a.proof_prover a.proof_parent.goal_name.Ident.id_string; *)
...
...
@@ -355,11 +364,11 @@ let run_external_proof eS eT ?callback a =
try
if
nap
==
ap
then
raise
Not_found
;
let
np_a
=
PHprover
.
find
g
.
goal_external_proofs
nap
in
if
O
.
replace_prover
np_a
a
then
if
O
.
replace_prover
np_a
a
then
begin
(** The notification will be done by the new proof_attempt *)
O
.
remove
np_a
.
proof_key
;
raise
Not_found
raise
Not_found
end
with
Not_found
->
(** replace [a] by a new_proof attempt if [a.proof_prover] was not
...
...
@@ -369,7 +378,7 @@ let run_external_proof eS eT ?callback a =
let
a
=
copy_external_proof
~
notify
~
keygen
:
O
.
create
~
prover
:
nap
~
env_session
:
eS
a
in
O
.
init
a
.
proof_key
(
Proof_attempt
a
);
a
a
in
if
a
.
proof_edited_as
=
None
&&
npc
.
prover_config
.
Whyconf
.
interactive
then
...
...
@@ -378,17 +387,10 @@ let run_external_proof eS eT ?callback a =
(
Undone
Unedited
)
a
;
Util
.
apply_option2
()
callback
a
a
.
proof_state
end
else
else
begin
let
previous_result
,
previous_obs
=
a
.
proof_state
,
a
.
proof_obsolete
in
let
timelimit
=
match
previous_result
with
|
Done
{
Call_provers
.
pr_answer
=
Call_provers
.
Valid
;
Call_provers
.
pr_time
=
t
}
->
let
time
=
max
a
.
proof_timelimit
(
truncate
(
2
.
0
*.
t
))
in
set_timelimit
time
a
;
time
|
_
->
a
.
proof_timelimit
in
let
timelimit
=
adapt_timelimit
a
in
let
callback
result
=
begin
match
result
with
|
Undone
Interrupted
->
...
...
@@ -478,7 +480,7 @@ let run_prover eS eT ~context_unproved_goals_only ~timelimit pr a =
let
proof_successful_or_just_edited
a
=
match
a
.
proof_state
with
|
Done
{
Call_provers
.
pr_answer
=
Call_provers
.
Valid
}
|
Done
{
Call_provers
.
pr_answer
=
Call_provers
.
Valid
}
|
Undone
JustEdited
->
true
|
_
->
false
...
...
@@ -575,8 +577,8 @@ module Todo = struct
dprintf
debug
"[Sched] todo : %i@."
todo
.
todo
end
let
push_report
report
(
g
,
p
,
r
)
=
report
:=
(
g
.
goal_name
,
p
,
r
)
::!
report
let
push_report
report
(
g
,
p
,
t
,
r
)
=
report
:=
(
g
.
goal_name
,
p
,
t
,
r
)
::!
report
(** When no smoke *)
let
check_external_proof
eS
eT
todo
a
=
...
...
@@ -593,7 +595,7 @@ let check_external_proof eS eT todo a =
|
None
->
dprintf
debug
"[sched] prover not found : %a@."
Whyconf
.
print_prover
ap
;
Todo
.
_done
todo
(
g
,
ap
,
Prover_not_installed
)
Todo
.
_done
todo
(
g
,
ap
,
0
,
Prover_not_installed
)
(* set_proof_state ~notify ~obsolete:false a Undone *)
|
Some
(
nap
,
npc
)
->
let
g
=
a
.
proof_parent
in
...
...
@@ -613,21 +615,24 @@ let check_external_proof eS eT todo a =
~
notify
~
keygen
:
O
.
create
~
prover
:
nap
~
env_session
:
eS
a
in
O
.
init
a
.
proof_key
(
Proof_attempt
a
);
a
in
let
timelimit
=
adapt_timelimit
a
in
let
callback
result
=
match
result
with
|
Undone
Scheduled
|
Undone
Running
|
Undone
Interrupted
->
()
|
Undone
(
Unedited
|
JustEdited
)
->
assert
false
|
InternalFailure
msg
->
Todo
.
_done
todo
(
g
,
ap
,
(
CallFailed
msg
));
Todo
.
_done
todo
(
g
,
ap
,
timelimit
,
(
CallFailed
msg
));
set_proof_state
~
notify
~
obsolete
:
false
~
archived
:
false
result
a
|
Done
new_res
->
begin
match
a
.
proof_state
with
|
Done
old_res
->
Todo
.
_done
todo
(
g
,
ap
,
(
Result
(
new_res
,
old_res
)))
Todo
.
_done
todo
(
g
,
ap
,
timelimit
,
(
Result
(
new_res
,
old_res
)))
|
_
->
Todo
.
_done
todo
(
g
,
ap
,
No_former_result
new_res
)
Todo
.
_done
todo
(
g
,
ap
,
timelimit
,
No_former_result
new_res
)
end
;
set_proof_state
~
notify
~
obsolete
:
false
~
archived
:
false
result
a
...
...
@@ -644,7 +649,7 @@ let check_external_proof eS eT todo a =
String
.
concat
" "
(
npc
.
prover_config
.
Whyconf
.
command
::
npc
.
prover_config
.
Whyconf
.
extra_options
)
in
schedule_proof_attempt
eT
~
timelimit
:
a
.
proof_timelimit
~
memlimit
:
0
~
timelimit
~
memlimit
:
0
?
old
~
command
~
driver
:
npc
.
prover_driver
~
callback
...
...
@@ -661,19 +666,9 @@ let check_all eS eT ~callback =
eS
.
session
;
let
timeout
()
=
match
Todo
.
_end
todo
with
|
None
->
(*
Printf.eprintf "Progress: %d/%d\r%!" !proofs_done !proofs_to_do;
*)
true
|
Some
reports
->
(*
Printf.eprintf "\n%!";
*)
callback
!
reports
;
false
(* decr maximum_running_proofs; *)
|
None
->
true
|
Some
reports
->
callback
!
reports
;
false
in
(* incr maximum_running_proofs; *)
schedule_any_timeout
eT
timeout
...
...
@@ -682,7 +677,7 @@ let check_all eS eT ~callback =
(***********************************)
let
rec
play_on_goal_and_children
eS
eT
~
timelimit
todo
l
g
=
let
callback
_key
status
=
let
callback
_key
status
=
match
status
with
|
Undone
Running
|
Undone
Scheduled
->
()
|
_
->
...
...
@@ -690,7 +685,7 @@ let rec play_on_goal_and_children eS eT ~timelimit todo l g =
(* eprintf "todo decreased to %d@." todo.Todo.todo *)
in
List
.
iter
(
fun
p
->
(
fun
p
->
Todo
.
todo
todo
;
(* eprintf "todo increased to %d@." todo.Todo.todo; *)
(* eprintf "prover %a on goal %s@." *)
...
...
@@ -724,7 +719,7 @@ let play_all eS eT ~callback ~timelimit l =
in
schedule_any_timeout
eT
timeout
(** Transformation *)
...
...
src/session/session_scheduler.mli
View file @
c6dc4315
...
...
@@ -127,7 +127,7 @@ module Make(O: OBSERVER) : sig
O
.
key
env_session
->
t
->
?
callback
:
(
O
.
key
proof_attempt
->
proof_attempt_status
->
unit
)
->
O
.
key
proof_attempt
->
unit
(** [redo_external_proof es sched ?timelimit p g] run
(** [redo_external_proof es sched ?timelimit p g] run
*)
...
...
@@ -214,14 +214,15 @@ module Make(O: OBSERVER) : sig
val
check_all
:
O
.
key
env_session
->
t
->
callback
:
((
Ident
.
ident
*
Whyconf
.
prover
*
report
)
list
->
unit
)
->
unit
callback
:
((
Ident
.
ident
*
Whyconf
.
prover
*
int
*
report
)
list
->
unit
)
->
unit
(** [check_all session callback] reruns all the proofs of the
session, and reports for all proofs the current result and the
new one (does not change the session state) When finished,
calls the callback with the reports which are
tri
ples (goal
name, prover, report) *)
calls the callback with the reports which are
4-u
ples (goal
name, prover,
timelimit,
report) *)
val
play_all
:
val
play_all
:
O
.
key
env_session
->
t
->
callback
:
(
unit
->
unit
)
->
timelimit
:
int
->
Whyconf
.
prover
list
->
unit
(** [play_all es sched l] runs every prover of list [l] on all
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment