changeset 760:21f6d2e65685

Megaform test
author Adam Chlipala <adamc@hcoop.net>
date Thu, 30 Apr 2009 14:43:55 -0400
parents 67cd8326f743
children 16b34dc2e29c
files lib/ur/basis.urs src/c/urweb.c tests/megaform.ur tests/megaform.urp tests/megaform.urs
diffstat 5 files changed, 128 insertions(+), 26 deletions(-) [+]
line wrap: on
line diff
--- a/lib/ur/basis.urs	Thu Apr 30 13:47:46 2009 -0400
+++ b/lib/ur/basis.urs	Thu Apr 30 14:43:55 2009 -0400
@@ -508,6 +508,7 @@
 con head = [Head]
 con body = [Body]
 con form = [Body, Form]
+con subform = [Body, Subform]
 con tabl = [Body, Table]
 con tr = [Body, Tr]
 
@@ -570,7 +571,7 @@
 val subforms : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type}
               -> [[Form] ~ ctx] =>
     nm :: Name -> [[nm] ~ use] =>
-    xml [Body, Subform] [Entry = $bind] []
+    xml subform [Entry = $bind] []
     -> xml ([Form] ++ ctx) use [nm = list ($bind)]
 
 val entry : ctx ::: {Unit} -> bind ::: {Type}
--- a/src/c/urweb.c	Thu Apr 30 13:47:46 2009 -0400
+++ b/src/c/urweb.c	Thu Apr 30 14:43:55 2009 -0400
@@ -591,28 +591,28 @@
   else if (ctx->cur_container->kind == ENTRY)
     return ctx->cur_container->data.entry.fields;
   else
-    uw_error(ctx, FATAL, "INP: Wrong kind");
+    uw_error(ctx, FATAL, "INP: Wrong kind (%d, %p)", ctx->cur_container->kind, ctx->cur_container);
 }
 
-static void adjust_input(input *x, size_t offset) {
+static void adjust_pointer(input **ptr, input *old_start, input *new_start, size_t len) {
+  if (*ptr != NULL && *ptr >= old_start && *ptr < old_start + len)
+    *ptr += new_start - old_start;
+}
+
+static void adjust_input(input *x, input *old_start, input *new_start, size_t len) {
   switch (x->kind) {
   case SUBFORM:
-    x->data.subform.fields += offset;
-    if (x->data.subform.parent != NULL)
-      x->data.subform.parent += offset;
+    adjust_pointer(&x->data.subform.fields, old_start, new_start, len);
+    adjust_pointer(&x->data.subform.parent, old_start, new_start, len);
     break;
   case SUBFORMS:
-    if (x->data.subforms.entries != NULL)
-      x->data.subforms.entries += offset;
-    if (x->data.subforms.parent != NULL)
-      x->data.subforms.parent += offset;
+    adjust_pointer(&x->data.subforms.entries, old_start, new_start, len);
+    adjust_pointer(&x->data.subforms.parent, old_start, new_start, len);
     break;
   case ENTRY:
-    x->data.entry.fields += offset;
-    if (x->data.entry.next != NULL)
-      x->data.entry.next += offset;
-    if (x->data.entry.parent != NULL)
-      x->data.entry.parent += offset;
+    adjust_pointer(&x->data.entry.fields, old_start, new_start, len);
+    adjust_pointer(&x->data.entry.next, old_start, new_start, len);
+    adjust_pointer(&x->data.entry.parent, old_start, new_start, len);
   }  
 }
 
@@ -624,16 +624,17 @@
     input *new_subinputs = realloc(ctx->subinputs, sizeof(input) * (ctx->used_subinputs + len));
     size_t offset = new_subinputs - ctx->subinputs;
 
-    for (i = 0; i < ctx->used_subinputs; ++i)
-      adjust_input(&new_subinputs[i], offset);
-    for (i = 0; i < uw_inputs_len; ++i)
-      adjust_input(&ctx->inputs[i], offset);
-
-    if (ctx->cur_container >= ctx->subinputs && ctx->cur_container < ctx->subinputs + ctx->n_subinputs)
-      ctx->cur_container += offset;
-
-    ctx->n_subinputs = ctx->used_subinputs + len;
-    ctx->subinputs = new_subinputs;
+    if (ctx->subinputs != new_subinputs) {
+      for (i = 0; i < ctx->used_subinputs; ++i)
+        adjust_input(&new_subinputs[i], ctx->subinputs, new_subinputs, ctx->used_subinputs);
+      for (i = 0; i < uw_inputs_len; ++i)
+        adjust_input(&ctx->inputs[i], ctx->subinputs, new_subinputs, ctx->used_subinputs);
+
+      adjust_pointer(&ctx->cur_container, ctx->subinputs, new_subinputs, ctx->used_subinputs);
+
+      ctx->n_subinputs = ctx->used_subinputs + len;
+      ctx->subinputs = new_subinputs;
+    }
   }
 
   r = &ctx->subinputs[ctx->used_subinputs];
@@ -791,6 +792,35 @@
 
 void *uw_malloc(uw_context ctx, size_t len);
 
+
+static void parents(input *inp) {
+  printf("Stack: %p\n", inp);
+  while (inp) {
+    switch (inp->kind) {
+    case NORMAL:
+      printf("Normal(%p)\n", inp);
+      break;
+    case FIL:
+      printf("File(%p)\n", inp);
+      break;
+    case SUBFORM:
+      printf("Subform; fields = %p\n", inp->data.subform.fields);
+      inp = inp->data.subform.parent;
+      break;
+    case SUBFORMS:
+      printf("Subforms; entries = %p\n", inp->data.subforms.entries);
+      inp = inp->data.subforms.parent;
+      break;
+    case ENTRY:
+      printf("Entry; fields = %p; next = %p\n", inp->data.entry.fields, inp->data.entry.next);
+      inp = inp->data.entry.parent;
+      break;
+    default:
+      inp = NULL;
+    }
+  }
+}
+
 uw_Basis_file uw_get_file_input(uw_context ctx, int n) {
   if (n < 0)
     uw_error(ctx, FATAL, "Negative file input index %d", n);
@@ -838,7 +868,7 @@
     uw_error(ctx, FATAL, "Tried to read an entry form input as subform");
   case SUBFORM:
     INP(ctx)[n].data.subform.parent = ctx->cur_container;
-    ctx->cur_container = INP(ctx)[n].data.subform.fields;
+    ctx->cur_container = &INP(ctx)[n];
     return;
   default:
     uw_error(ctx, FATAL, "Impossible input kind");
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/megaform.ur	Thu Apr 30 14:43:55 2009 -0400
@@ -0,0 +1,67 @@
+fun handler'' ls =
+    case ls of
+        Nil => <xml/>
+      | Cons (r, ls) => <xml><li>{[r.C]}</li>{handler'' ls}</xml>
+
+fun handler' ls =
+    case ls of
+        Nil => <xml/>
+      | Cons (r, ls) => <xml><li>{[r.Sub.A]} <ul>{handler'' r.Sub.Sub2}</ul></li>{handler' ls}</xml>
+
+fun handler r = return <xml><body>
+  {[r.A]}
+  <ul>{handler' r.Sub}</ul>
+  {[r.C]}<br/>
+  {[r.Sub2.A]}<br/>
+  {handler'' r.Sub2.Nested}
+</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <textbox{#A}/><br/>
+    <subforms{#Sub}>
+      <entry>
+        <subform{#Sub}>
+          <textbox{#A}/><br/>
+          <subforms{#Sub2}>
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+          </subforms>
+        </subform>
+      </entry>
+
+      <entry>
+        <subform{#Sub}>
+          <textbox{#A}/><br/>
+          <subforms{#Sub2}>
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+
+            <entry>
+              <textbox{#C}/><br/>
+            </entry>
+          </subforms>
+        </subform>
+      </entry>
+    </subforms>
+    <textbox{#C}/><br/>
+
+    <subform{#Sub2}>
+      <textbox{#A}/><br/>
+
+      <subforms{#Nested}>
+        <entry>
+          <textbox{#C}/>
+        </entry>
+      </subforms>
+    </subform><br/>
+
+    <submit action={handler}/>
+  </form>
+</body></xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/megaform.urp	Thu Apr 30 14:43:55 2009 -0400
@@ -0,0 +1,3 @@
+debug
+
+megaform
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/megaform.urs	Thu Apr 30 14:43:55 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page