[PPL-devel] [GIT] ppl/ppl(master): Register PPL_timeout_exception in the OCaml interface.
Enea Zaffanella
zaffanella at cs.unipr.it
Mon Mar 30 17:50:49 CEST 2009
Module: ppl/ppl
Branch: master
Commit: 9677eb06b871033c05f54a552fc6f583bda2fff5
URL: http://www.cs.unipr.it/git/gitweb.cgi?p=ppl/ppl.git;a=commit;h=9677eb06b871033c05f54a552fc6f583bda2fff5
Author: Enea Zaffanella <zaffanella at 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;; *)
More information about the PPL-devel
mailing list