From cfffcb997d0345f90444725248c7c85b035c30b4 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Thu, 14 Oct 2010 11:35:56 -0400
Subject: -limit for running time

---
 include/urweb.h  |  2 ++
 src/c/request.c  | 25 +++++++++++++++++++++++--
 src/c/urweb.c    |  2 +-
 src/settings.sml |  8 ++++++--
 tests/thog.ur    |  9 +++++++++
 tests/thog.urp   |  2 ++
 tests/thog.urs   |  1 +
 7 files changed, 44 insertions(+), 5 deletions(-)
 create mode 100644 tests/thog.ur
 create mode 100644 tests/thog.urp
 create mode 100644 tests/thog.urs

diff --git a/include/urweb.h b/include/urweb.h
index 3f5bf285..e9e330b8 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -284,4 +284,6 @@ void uw_set_client_data(uw_context, void *);
 
 uw_Basis_int uw_Basis_rand(uw_context);
 
+extern int uw_time_max;
+
 #endif
diff --git a/src/c/request.c b/src/c/request.c
index f72a3199..190a327f 100644
--- a/src/c/request.c
+++ b/src/c/request.c
@@ -70,6 +70,15 @@ uw_context uw_request_new_context(uw_app *app, void *logger_data, uw_logger log_
   return ctx;
 }
 
+static void *ticker(void *data) {
+  while (1) {
+    usleep(100000);
+    ++uw_time;
+  }
+
+  return NULL;
+}
+
 void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_logger log_debug) {
   uw_context ctx;
   failure_kind fk;
@@ -77,6 +86,15 @@ void uw_request_init(uw_app *app, void *logger_data, uw_logger log_error, uw_log
   uw_global_init();
   uw_app_init(app);
 
+  {
+    pthread_t thread;
+    
+    if (uw_time_max && pthread_create(&thread, NULL, ticker, NULL)) {
+      fprintf(stderr, "Error creating ticker thread\n");
+      exit(1);
+    }
+  }
+
   ctx = uw_request_new_context(app, logger_data, log_error, log_debug);
 
   if (!ctx)
@@ -348,15 +366,18 @@ request_result uw_request(uw_request_context rc, uw_context ctx,
         rc->path_copy = realloc(rc->path_copy, rc->path_copy_size);
       }
       strcpy(rc->path_copy, path);
+
+      uw_set_deadline(ctx, uw_time + uw_time_max);
       fk = uw_begin(ctx, rc->path_copy);
-    } else
+    } else {
+      uw_set_deadline(ctx, uw_time + uw_time_max);
       fk = uw_begin_onError(ctx, errmsg);
+    }
 
     if (fk == SUCCESS || fk == RETURN_INDIRECTLY) {
       uw_commit(ctx);
       if (uw_has_error(ctx) && !had_error) {
         log_error(logger_data, "Fatal error: %s\n", uw_error_message(ctx));
-
         uw_reset_keep_error_message(ctx);
         on_failure(ctx);
 
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 747f62b6..bdaa877f 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -348,7 +348,7 @@ void uw_app_init(uw_app *app) {
   app->client_init();
 }
 
-int uw_time = 0;
+int uw_time = 0, uw_time_max = 0;
 
 
 // Single-request state
diff --git a/src/settings.sml b/src/settings.sml
index 4512b7d8..b5ba4f9b 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -492,12 +492,16 @@ fun getOnError () = !onError
 
 val limits = ["messages", "clients", "headers", "page", "heap", "script",
               "inputs", "subinputs", "cleanup", "deltas", "transactionals",
-              "globals", "database"]
+              "globals", "database", "time"]
 
 val limitsList = ref ([] : (string * int) list)
 fun addLimit (v as (name, _)) =
     if List.exists (fn name' => name' = name) limits then
-        limitsList := v :: !limitsList
+        (limitsList := v :: !limitsList;
+         if name = "time" then
+             setDeadlines true
+         else
+             ())
     else
         raise Fail ("Unknown limit category '" ^ name ^ "'")
 fun limits () = !limitsList
diff --git a/tests/thog.ur b/tests/thog.ur
new file mode 100644
index 00000000..29e335fc
--- /dev/null
+++ b/tests/thog.ur
@@ -0,0 +1,9 @@
+fun ack (m, n) =
+    if m = 0 then
+        n + 1
+    else if n = 0 then
+        ack (m - 1, 1)
+    else
+        ack (m - 1, ack (m, n - 1))
+
+fun main n = return <xml>{[ack (n, 4)]}</xml>
diff --git a/tests/thog.urp b/tests/thog.urp
new file mode 100644
index 00000000..e9e7e469
--- /dev/null
+++ b/tests/thog.urp
@@ -0,0 +1,2 @@
+$/list
+thog
diff --git a/tests/thog.urs b/tests/thog.urs
new file mode 100644
index 00000000..38b757ea
--- /dev/null
+++ b/tests/thog.urs
@@ -0,0 +1 @@
+val main : int -> transaction page
-- 
cgit v1.2.3