Module: ppl/ppl Branch: master Commit: 9677eb06b871033c05f54a552fc6f583bda2fff5 URL: http://www.cs.unipr.it/git/gitweb.cgi?p=ppl/ppl.git;a=commit;h=9677eb06b8710...
Author: Enea Zaffanella zaffanella@cs.unipr.it Date: Mon Mar 30 18:47:53 2009 +0200
Register PPL_timeout_exception in the OCaml interface. Avoid flood of warnings by directly thowing CAML exceptions in CATCH_ALL. Still debugging the handling of timeouts.
---
.../OCaml/ppl_interface_generator_ocaml_ml.m4 | 2 +- interfaces/OCaml/ppl_ocaml_common.cc | 14 +--- interfaces/OCaml/ppl_ocaml_common.defs.hh | 48 ++++++----- interfaces/OCaml/tests/Makefile.am | 9 ++- interfaces/OCaml/tests/test1.ml | 91 +++++++++++--------- 5 files changed, 85 insertions(+), 79 deletions(-)
diff --git a/interfaces/OCaml/ppl_interface_generator_ocaml_ml.m4 b/interfaces/OCaml/ppl_interface_generator_ocaml_ml.m4 index a54e157..7379217 100644 --- a/interfaces/OCaml/ppl_interface_generator_ocaml_ml.m4 +++ b/interfaces/OCaml/ppl_interface_generator_ocaml_ml.m4 @@ -42,7 +42,7 @@ let _ = Callback.register_exception "PPL_arithmetic_overflow" (Error "any string let _ = Callback.register_exception "PPL_internal_error" (Error "any string") let _ = Callback.register_exception "PPL_unknown_standard_exception" (Error "any string") let _ = Callback.register_exception "PPL_not_an_unsigned_exception" (Error "any string") - +let _ = Callback.register_exception "PPL_timeout_error" (Error "any string") let _ = Callback.register_exception "PPL_unexpected_error" (Error "any string")
m4_divert(-1) diff --git a/interfaces/OCaml/ppl_ocaml_common.cc b/interfaces/OCaml/ppl_ocaml_common.cc index a705ffd..e13a4ee 100644 --- a/interfaces/OCaml/ppl_ocaml_common.cc +++ b/interfaces/OCaml/ppl_ocaml_common.cc @@ -83,25 +83,17 @@ class PFunc {
Parma_Watchdog_Library::Watchdog* p_timeout_object = 0;
+#endif // PPL_WATCHDOG_LIBRARY_ENABLED + void reset_timeout() { +#ifdef PPL_WATCHDOG_LIBRARY_ENABLED if (p_timeout_object) { delete p_timeout_object; p_timeout_object = 0; abandon_expensive_computations = 0; } -} - #endif // PPL_WATCHDOG_LIBRARY_ENABLED - -void -handle_timeout_exception() { -#ifdef PPL_WATCHDOG_LIBRARY_ENABLED - assert(p_timeout_object); - reset_timeout(); -#endif - caml_raise_with_string(*caml_named_value("PPL_timeout_exception"), - "timeout expired"); }
namespace { diff --git a/interfaces/OCaml/ppl_ocaml_common.defs.hh b/interfaces/OCaml/ppl_ocaml_common.defs.hh index 294cf82..a893b20 100644 --- a/interfaces/OCaml/ppl_ocaml_common.defs.hh +++ b/interfaces/OCaml/ppl_ocaml_common.defs.hh @@ -170,7 +170,7 @@ public: } };
-void handle_timeout_exception(); +void reset_timeout();
} // namespace OCaml
@@ -181,28 +181,30 @@ void handle_timeout_exception(); #define CATCH_ALL \ catch(std::bad_alloc&) { \ caml_raise_out_of_memory(); \ - } \ - catch(std::invalid_argument& e) { \ - caml_invalid_argument(const_cast<char*>(e.what())); \ - } \ - catch(std::overflow_error& e) { \ - caml_raise_with_string(*caml_named_value("PPL_arithmetic_overflow"), \ - (const_cast<char*>(e.what()))); \ - } \ - catch(std::runtime_error& e) { \ - caml_raise_with_string(*caml_named_value("PPL_internal_error"), \ - (const_cast<char*>(e.what()))); \ - } \ - catch(timeout_exception&) { \ - handle_timeout_exception(); \ - } \ - catch(std::exception& e) { \ - caml_raise_with_string(*caml_named_value("PPL_unknown_standard_exception"), \ - (const_cast<char*>(e.what()))); \ - } \ - catch(...) { \ - caml_raise_constant(*caml_named_value("PPL_unexpected_error")); \ - } +} \ +catch(std::invalid_argument& e) { \ + caml_invalid_argument(const_cast<char*>(e.what())); \ +} \ +catch(std::overflow_error& e) { \ + caml_raise_with_string(*caml_named_value("PPL_arithmetic_overflow"), \ + (const_cast<char*>(e.what()))); \ +} \ +catch(std::runtime_error& e) { \ + caml_raise_with_string(*caml_named_value("PPL_internal_error"), \ + (const_cast<char*>(e.what()))); \ +} \ +catch(std::exception& e) { \ + caml_raise_with_string(*caml_named_value("PPL_unknown_standard_exception"), \ + (const_cast<char*>(e.what()))); \ +} \ +catch(timeout_exception&) { \ + reset_timeout(); \ + caml_raise_with_string(*caml_named_value("PPL_timeout_exception"), \ + "timeout expired"); \ +} \ +catch(...) { \ + caml_raise_constant(*caml_named_value("PPL_unexpected_error")); \ +}
#include "ppl_ocaml_common.inlines.hh"
diff --git a/interfaces/OCaml/tests/Makefile.am b/interfaces/OCaml/tests/Makefile.am index f6047ca..ca98b4a 100644 --- a/interfaces/OCaml/tests/Makefile.am +++ b/interfaces/OCaml/tests/Makefile.am @@ -34,8 +34,7 @@ CHECKER = endif !VALGRIND_TESTS_ENABLED
TESTS_ENVIRONMENT = \ - $(LIBTOOL) --mode=execute \ - -dlopen ../../../src/libppl.la $(WATCHDOG_DLOPEN) $(CHECKER) + $(LIBTOOL) --mode=execute $(PPL_DLOPEN) $(PWL_DLOPEN) $(CHECKER)
interface_generator_files = \ ppl_interface_generator_ocaml_test_ml.m4 \ @@ -90,6 +89,12 @@ endif BUILD_WATCHDOG_LIBRARY
endif !ENABLE_SHARED
+PPL_DLOPEN = -dlopen ../../../src/libppl.la + +if BUILD_WATCHDOG_LIBRARY +PWL_DLOPEN = -dlopen ../../../Watchdog/src/libpwl.la +endif BUILD_WATCHDOG_LIBRARY + .ml.cmo: $(OCAMLC_ENV) ocamlc -o $@ -c $(OCAMLC_COMPILE_FLAGS) $<
diff --git a/interfaces/OCaml/tests/test1.ml b/interfaces/OCaml/tests/test1.ml index 3366c85..62b3571 100644 --- a/interfaces/OCaml/tests/test1.ml +++ b/interfaces/OCaml/tests/test1.ml @@ -219,47 +219,6 @@ let congruence1 = (e2, e2 , (Z.from_int 1));; let congruences1 = [e3, e2 , (Z.from_int 20)];; let grid_generator1 = Grid_Point (e3, (Z.from_int 1));;
-(* Testing timeouts *) -let lower = Coefficient(Gmp.Z.of_int 0) -in let upper = Coefficient(Gmp.Z.of_int 1) -in let rec hypercube_cs dim = - begin - if dim < 0 then [] - else - Greater_Or_Equal(Variable dim, lower) - :: Less_Or_Equal(Variable dim, upper) - :: hypercube_cs (dim-1) - end -in let rec compute_timeout_hypercube dim_in dim_out = - if dim_in < dim_out then - let ph = ppl_new_C_Polyhedron_from_constraints (hypercube_cs dim_in) - in begin -(* FIXME. - try - let () = ppl_Polyhedron_get_minimized_constraints ph; - ppl_delete_Polyhedron ph - with x -> - raise x; -*) - compute_timeout_hypercube (dim_in + 1) dim_out - end -in begin - try - ppl_set_timeout 100; - compute_timeout_hypercube 0 2; - ppl_reset_timeout; - print_string_if_noisy "ppl_reset_timeout test succeeded\n"; - with x -> - print_string_if_noisy "ppl_reset_timeout test seems to be failed!\n"; - try - ppl_set_timeout 100; - compute_timeout_hypercube 0 100; - ppl_reset_timeout; - print_string_if_noisy "ppl_set_timeout test seems to be failed!\n"; - with x -> - print_string_if_noisy "ppl_set_timeout test succeded\n"; - end;; - let mip1 = ppl_new_MIP_Problem 10 constraints1 e3 Maximization;; let objective_func = ppl_MIP_Problem_objective_function mip1;; print_string_if_noisy "\n";; @@ -414,7 +373,7 @@ let b = ppl_banner ();; print_string_if_noisy "\n";; print_string_if_noisy "Banner is: "; print_string_if_noisy(b);; -print_string_if_noisy "\n";; +print_string_if_noisy "\n\n";; print_string_if_noisy "PPL Coefficient integer datatype is " ;; if (ppl_Coefficient_is_bounded()) then print_string_if_noisy "bounded\n" @@ -423,6 +382,54 @@ print_string_if_noisy "Maximum space dimension is: "; let i = ppl_max_space_dimension() in print_int_if_noisy i;; print_string_if_noisy "\n";; + +(* Testing timeouts *) +let lower = Coefficient(Gmp.Z.of_int 0) +and upper = Coefficient(Gmp.Z.of_int 1) +in let rec hypercube_cs dim = + if dim < 0 + then [] + else Greater_Or_Equal(Variable dim, lower) + :: Less_Or_Equal(Variable dim, upper) + :: hypercube_cs (dim-1) +and hypercube_ph dim = + ppl_new_C_Polyhedron_from_constraints (hypercube_cs dim) +and compute_timeout_hypercube dim_in dim_out = + if dim_in < dim_out then ( + let _ = ppl_Polyhedron_get_minimized_constraints (hypercube_ph dim_in) + in ( + print_string_if_noisy "Built hypercube of dimension "; + print_int_if_noisy dim_in; + print_string_if_noisy "\n" + ); + compute_timeout_hypercube (dim_in + 1) dim_out + ) +in ( + begin + try + print_string_if_noisy "\nStarting ppl_reset_timeout test:\n"; + ppl_set_timeout 100; + compute_timeout_hypercube 0 2; + ppl_reset_timeout (); + print_string_if_noisy "ppl_reset_timeout test succeeded.\n" + with x -> + print_string_if_noisy "ppl_reset_timeout test seems to be failed!\n" + end +(* DEBUGGING + ; + begin + try + print_string "\nStarting ppl_set_timeout test:\n"; + ppl_set_timeout 100; + compute_timeout_hypercube 0 100; + ppl_reset_timeout (); + print_string "ppl_set_timeout test seems to be failed!\n" + with x -> + print_string "ppl_set_timeout test succeded\n" + end +DEBUGGING *) +);; + (* Pointset_Powersed_Grid is not enabled by default, the following code is *) (* commented *) (* let pps = ppl_new_Pointset_Powerset_Grid_from_space_dimension 3;; *)