# HG changeset patch # User Adam Chlipala # Date 1241117035 14400 # Node ID 21f6d2e65685cbd946a99e9e8d9229675b4ba2e5 # Parent 67cd8326f743b21aa613e19480db38b934917fc6 Megaform test diff -r 67cd8326f743 -r 21f6d2e65685 lib/ur/basis.urs --- 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} diff -r 67cd8326f743 -r 21f6d2e65685 src/c/urweb.c --- 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"); diff -r 67cd8326f743 -r 21f6d2e65685 tests/megaform.ur --- /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 => + | Cons (r, ls) =>
  • {[r.C]}
  • {handler'' ls}
    + +fun handler' ls = + case ls of + Nil => + | Cons (r, ls) =>
  • {[r.Sub.A]}
      {handler'' r.Sub.Sub2}
  • {handler' ls}
    + +fun handler r = return + {[r.A]} +
      {handler' r.Sub}
    + {[r.C]}
    + {[r.Sub2.A]}
    + {handler'' r.Sub2.Nested} +
    + +fun main () = return +
    +
    + + + +
    + + +
    +
    + + +
    +
    + + +
    + + + +
    + + +
    +
    + + +
    +
    + + +
    + +
    + + +
    + + + + + + +
    + + + +
    diff -r 67cd8326f743 -r 21f6d2e65685 tests/megaform.urp --- /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 diff -r 67cd8326f743 -r 21f6d2e65685 tests/megaform.urs --- /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