diff options
| author |  Artyom Shalkhakov <artyom.shalkhakov@gmail.com> | 2019-01-27 15:51:22 +0200 |
|---|---|---|
| committer | Artyom Shalkhakov <artyom.shalkhakov@gmail.com> | 2019-01-27 15:51:22 +0200 |
| commit | ff20f86eb6e792b69c2b580444bd9b051aaf7752 (patch) | |
| tree | 89d1547b919a722c20de85fdd60d4117e1af54a7 | |
| parent | 726ff63ec6d084f2ef4d65b084ef204d5fcc5eb0 (diff) | |
| parent | 28ab84cb7b09e23aa0ed014bf2ed1fda56fcefc1 (diff) | |
Merge branch 'master' of https://github.com/urweb/urweb into endpoints
| -rw-r--r-- | doc/manual.tex | 19 | ||||
| -rw-r--r-- | include/urweb/urweb_cpp.h | 2 | ||||
| -rw-r--r-- | lib/js/urweb.js | 98 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 2 | ||||
| -rw-r--r-- | lib/ur/option.ur | 5 | ||||
| -rw-r--r-- | lib/ur/option.urs | 2 | ||||
| -rw-r--r-- | src/c/urweb.c | 111 | ||||
| -rw-r--r-- | src/cjr_print.sml | 24 | ||||
| -rw-r--r-- | src/mono_opt.sml | 65 | ||||
| -rw-r--r-- | src/settings.sml | 1 | ||||
| -rw-r--r-- | tests/utf8.ur | 1638 | ||||
| -rw-r--r-- | tests/utf8.urp | 1 |
12 files changed, 1556 insertions, 412 deletions
diff --git a/doc/manual.tex b/doc/manual.tex index 59727099..8f7787fc 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -2400,7 +2400,7 @@ A web application is built from a series of modules, with one module, the last o Elements of modules beside the main module, including page handlers, will only be included in the final application if they are transitive dependencies of the handlers in the main module. -Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects. To export a page which may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$. When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$). This kind of handler should not be used with forms that exist solely within Ur/Web apps; for these, use Ur/Web's built-in support, as described below. It may still be useful to use $\mt{Basis.postBody}$ with form requests submitted by code outside an Ur/Web app. For such cases, the function $\mt{Top.postFields} : \mt{postBody} \to \mt{list} \; (\mt{string} \times \mt{string})$ may be useful, breaking a \texttt{POST} body of type \texttt{application/x-www-form-urlencoded} into its name-value pairs. +Normal links are accessible via HTTP \texttt{GET}, which the relevant standard says should never cause side effects. To export a page that may cause side effects, accessible only via HTTP \texttt{POST}, include one argument of the page handler of type $\mt{Basis.postBody}$. When the handler is called, this argument will receive a value that can be deconstructed into a MIME type (with $\mt{Basis.postType}$) and payload (with $\mt{Basis.postData}$). This kind of handler should not be used with forms that exist solely within Ur/Web apps; for these, use Ur/Web's built-in support, as described below. It may still be useful to use $\mt{Basis.postBody}$ with form requests submitted by code outside an Ur/Web app. For such cases, the function $\mt{Top.postFields} : \mt{postBody} \to \mt{list} \; (\mt{string} \times \mt{string})$ may be useful, breaking a \texttt{POST} body of type \texttt{application/x-www-form-urlencoded} into its name-value pairs. Any normal page handler may also include arguments of type $\mt{option \; Basis.queryString}$, which will be handled specially. Rather than being deserialized from the current URI, such an argument is passed the whole query string that the handler received. The string may be analyzed by calling $\mt{Basis.show}$ on it. A handler of this kind may be passed as an argument to $\mt{Basis.effectfulUrl}$ to generate a URL to a page that may be used as a ``callback'' by an external service, such that the handler is allowed to cause side effects. @@ -2419,9 +2419,7 @@ Ur/Web programs generally mix server- and client-side code in a fairly transpare \medskip -The HTTP standard suggests that GET requests only be used in ways that generate no side effects. Side effecting operations should use POST requests instead. The Ur/Web compiler enforces this rule strictly, via a simple conservative program analysis. Any page that may have a side effect must be accessed through a form, all of which use POST requests, or via a direct call to a page handler with some argument of type $\mt{Basis.postBody}$. A page is judged to have a side effect if its code depends syntactically on any of the side-effecting, server-side FFI functions. Links, forms, and most client-side event handlers are not followed during this syntactic traversal, but \texttt{<body onload=\{...\}>} handlers \emph{are} examined, since they run right away and could just as well be considered parts of main page handlers. - -Ur/Web includes a kind of automatic protection against cross site request forgery attacks. Whenever any page execution can have side effects and can also read at least one cookie value, all cookie values must be signed cryptographically, to ensure that the user has come to the current page by submitting a form on a real page generated by the proper server. Signing and signature checking are inserted automatically by the compiler. This prevents attacks like phishing schemes where users are directed to counterfeit pages with forms that submit to your application, where a user's cookies might be submitted without his knowledge, causing some undesired side effect. +The HTTP standard suggests that GET requests only be used in ways that generate no side effects. Side-effecting operations should use POST requests instead. The Ur/Web compiler enforces this rule strictly, via a simple conservative program analysis. Any page that may have a side effect must be accessed through a form, all of which use POST requests, or via a direct call to a page handler with some argument of type $\mt{Basis.postBody}$. A page is judged to have a side effect if its code depends syntactically on any of the side-effecting, server-side FFI functions. Links, forms, and most client-side event handlers are not followed during this syntactic traversal, but \texttt{<body onload=\{...\}>} handlers \emph{are} examined, since they run right away and could just as well be considered parts of main page handlers. \subsection{Tasks} @@ -2443,6 +2441,19 @@ The currently supported task kinds are: \item $\mt{periodic} \; n$: Code that is run when the application starts up and then every $n$ seconds thereafter. \end{itemize} +\subsection{Security Model} + +Ur/Web follows a pragmatic security model that, nonetheless, isn't magic. The warranty can be voided using the foreign function interface (FFI; see next section), but it is easy to check if that interface is being used, solely by inspecting \texttt{.urp} files. If such inspection shows no use of the FFI, then a number of classic security problems are precluded (modulo bugs in the implementation of Ur/Web itself, of course): +\begin{itemize} +\item There can be no \textbf{code-injection attacks}. That is, strings are never implicitly interpreted as programs and run, which can be particularly problematic for strings coming from unconstrained user input. In the case of SQL code, the specialized name for such vulnerabilities is \emph{SQL injections}. In the case of HTML or JavaScript code, the specialized name is \emph{cross-site scripting}. Ur/Web programmers need not worry about the difference, because the Ur/Web implementation promises that you will know if a string is being interpreted as a program! +\item Ur/Web includes a kind of automatic protection against \textbf{cross-site request forgery (CSRF) attacks}. Whenever any page execution can have side effects and can also read at least one cookie value, all cookie values must be signed cryptographically, to ensure that the user has come to the current page by submitting a form on a real page generated by the proper server. Signing and signature checking are inserted automatically by the compiler. This prevents attacks like phishing schemes where users are directed to counterfeit pages with forms that submit to your application, where a user's cookies might be submitted without his knowledge, causing some undesired side effect that the attacker couldn't cause directly due to lack of knowledge. +\item Quite a lot of other insecure monkey business can go in web applications. Ur/Web contains a pretty locked-down standard library, so that, for instance, it is not possible for Ur/Web code to access the file system directly... ergo it is not possible to leak secret file contents or overwrite files insecurely! The FFI must be used to summon such rights explicitly. +\end{itemize} + +However, Ur/Web doesn't guarantee ``any code that compiles is secure.'' The right model is that \emph{any HTTP endpoint exposed by the application can be called at any time with any argument values and any cookie values}. Ur/Web does nothing to guarantee that all function calls experienced by the application are possible according to legit traversal of links and forms! In particular, the cryptographic signing mentioned above is \emph{not} used to prevent users from making up whatever cookie values they like. It is just used to make sure an application only takes action based on cookie values when the user has explicitly submitted a form (and presumably the application author takes care to make all forms sufficiently intuitive, so none have surprising side effects that defy security or privacy expectations). + +Another philosophical assumption is that \emph{there is no hope of protecting a user against an attacker with access to the legit user's browser}. For instance, any attacker who can observe the HTML code of one page with CSRF protection is now able to trick the user into running arbitrary handler functions, since a cookie signature is not specific to the destination handler. Sure, we would improve security slightly (at the expense of Ur/Web implementation complexity) by making signatures handler-specific or even handler-argument-specific, but the idea is that you have already lost if an attacker has that kind of access to your browser. (And he needs browser access to see the page because of course your security-critical app is accessed only via TLS, right?) + \section{\label{ffi}The Foreign Function Interface} diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 25f97fb3..18b5f583 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -138,6 +138,7 @@ char *uw_Basis_urlifySource(struct uw_context *, uw_Basis_source); uw_unit uw_Basis_urlifyInt_w(struct uw_context *, uw_Basis_int); uw_unit uw_Basis_urlifyFloat_w(struct uw_context *, uw_Basis_float); +uw_unit uw_Basis_urlifyChar_w(struct uw_context *, uw_Basis_char); uw_unit uw_Basis_urlifyString_w(struct uw_context *, uw_Basis_string); uw_unit uw_Basis_urlifyBool_w(struct uw_context *, uw_Basis_bool); uw_unit uw_Basis_urlifyTime_w(struct uw_context *, uw_Basis_time); @@ -262,6 +263,7 @@ uw_Basis_string uw_Basis_fileMimeType(struct uw_context *, uw_Basis_file); uw_Basis_blob uw_Basis_fileData(struct uw_context *, uw_Basis_file); uw_Basis_int uw_Basis_blobSize(struct uw_context *, uw_Basis_blob); uw_Basis_blob uw_Basis_textBlob(struct uw_context *, uw_Basis_string); +uw_Basis_string uw_Basis_textOfBlob(struct uw_context *, uw_Basis_blob); uw_Basis_string uw_Basis_postType(struct uw_context *, uw_Basis_postBody); uw_Basis_string uw_Basis_postData(struct uw_context *, uw_Basis_postBody); diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 931ab1f5..1c296fe1 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -7,6 +7,61 @@ function needsDynPrefix() { return scripts.length == 0; } +// Codepoint implementations brought from https://norbertlindenberg.com/2012/05/ecmascript-supplementary-characters/#String +if (!String.fromCodePoint) { + String.fromCodePoint = function () { + var chars = [], i; + for(i = 0; i < arguments.length; ++i) { + var c = Number(arguments[i]); + if (!isFinite(c) || c < 0 || c > 0x10FFFF || Math.floor(c) !== c) { + throw new RangeError("Invalid code point " + c); + } + if (c < 0x10000) { + chars.push(c); + } else { + c -= 0x10000; + chars.push((c >> 10) + 0xD800); + chars.push((c % 0x400) + 0xDC00); + } + } + return String.fromCharCode.apply(undefined, chars); + }; + + String.prototype.codePointAt = function (index) { + var str = String(this); + if (index < 0 || index >= str.length) { + return undefined; + } + var first = str.charCodeAt(index); + if (first >= 0xD800 && first <= 0xDBFF && str.length > index + 1) { + var second = str.charCodeAt(index + 1); + if (second >= 0xDC00 && second <= 0xDFFF) { + return ((first - 0xD800) << 10) + (second - 0xDC00) + 0x10000; + } + } + return first; + }; +} + +function iterateString(s, fn) { + var strIdx = 0, idx = 0, res, cp; + for (; strIdx < s.length ;) { + cp = s.codePointAt(strIdx); + if (fn) { + res = fn(String.fromCodePoint(cp), idx, strIdx); + if (res === false) return; + } + strIdx += cp > 0xFFFF ? 2 : 1; + ++idx; + } +} + +function strSplit(s) { + var chars = []; + iterateString(s, function(c) { chars.push(c); }); + return chars; +} + var dynPrefix = needsDynPrefix() ? "<span style=\"display:none\">A</span>" : ""; // Function versions of operators @@ -2216,9 +2271,6 @@ function setSelectValue(x, v) { return; } } - - if (v != "") - er("Setting <select> to nonexistent value: " + v); } function sel(s, content) { @@ -2438,11 +2490,24 @@ function s2b(s) { return s == "True" ? true : s == "False" ? false : null; } function s2be(s) { return s == "True" ? true : s == "False" ? false : er("Illegal Boolean " ^ s); } function id(x) { return x; } -function sub(s, i) { return Array.from(s)[i]; } -function suf(s, i) { return Array.from(s).slice(i).join(""); } -function slen(s) { return Array.from(s).length; } +function sub(s, i) { + var ch = undefined; + iterateString(s, function(c, idx) { if (idx == i) { ch = c; return false; }}); + return ch; +} +function suf(s, i) { + var off = s.length; + iterateString(s, function(_, idx, sidx) { if (idx == i) { off = sidx; return false; } }); + return s.substring(off); +} +function slen(s) { + var len = 0; + iterateString(s, function(){ ++len;}); + return len; +} function sidx(s, ch) { - var r = Array.from(s).indexOf(ch); + var r = -1; + iterateString(s, function(c, idx){ if (c == ch) { r = idx; return false; } }); if (r == -1) return null; else @@ -2450,8 +2515,8 @@ function sidx(s, ch) { } function ssidx(h, n) { if (n == "") return 0; - var ah = Array.from(h); - var an = Array.from(n); + var ah = strSplit(h); + var an = strSplit(n); var i = 0, y = 0; var top = ah.length - an.length + 1; if (top < 0) top = 0; @@ -2474,8 +2539,8 @@ function ssidx(h, n) { } function sspn(s, chs) { - var s2 = Array.from(s); - var chs2 = Array.from(chs); + var s2 = strSplit(s); + var chs2 = strSplit(chs); for (var i = 0; i < s2.length; ++i) if (chs2.indexOf(s2[i]) != -1) @@ -2483,6 +2548,7 @@ function sspn(s, chs) { return s2.length; } + function schr(s, ch) { var r = s.indexOf(ch); if (r == -1) @@ -2491,7 +2557,7 @@ function schr(s, ch) { return s.substring(r); } function ssub(s, start, len) { - return Array.from(s).slice(start, start+len).join(""); + return strSplit(s).slice(start, start+len).join(""); } function strlenGe(s, len) { return slen(s) >= len; @@ -3228,7 +3294,7 @@ function bless(s) { var maxCh = chr(127); function blessData(s) { - var chars = Array.from(s); + var chars = strSplit(s); for (var i = 0; i < chars.length; ++i) { var c = chars[i]; @@ -3243,7 +3309,7 @@ function blessData(s) { // CSS validation function atom(s) { - var chars = Array.from(s); + var chars = strSplit(s); for (var i = 0; i < chars.length; ++i) { var c = chars[i]; @@ -3255,7 +3321,7 @@ function atom(s) { } function css_url(s) { - var chars = Array.from(s); + var chars = strSplit(s); for (var i = 0; i < chars.length; ++i) { var c = chars[i]; @@ -3268,7 +3334,7 @@ function css_url(s) { } function property(s) { - var chars = Array.from(s); + var chars = strSplit(s); if (chars.length <= 0) er("Empty CSS property"); diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index c893e65d..be13c684 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -1019,6 +1019,8 @@ val checkMime : string -> option mimeType val returnBlob : t ::: Type -> blob -> mimeType -> transaction t val blobSize : blob -> int val textBlob : string -> blob +val textOfBlob : blob -> option string +(* Returns [Some] exactly when the blob contains no zero bytes. *) type postBody val postType : postBody -> string diff --git a/lib/ur/option.ur b/lib/ur/option.ur index baa08466..dd186161 100644 --- a/lib/ur/option.ur +++ b/lib/ur/option.ur @@ -59,3 +59,8 @@ fun unsafeGet [a] (o : option a) = case o of None => error <xml>Option.unsafeGet: encountered None</xml> | Some v => v + +fun mapM [m] (_ : monad m) [a] [b] (f : a -> m b) (x : t a) : m (t b) = + case x of + None => return None + | Some y => z <- f y; return (Some z) diff --git a/lib/ur/option.urs b/lib/ur/option.urs index c30c40e7..705c0313 100644 --- a/lib/ur/option.urs +++ b/lib/ur/option.urs @@ -14,3 +14,5 @@ val bind : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> t b val get : a ::: Type -> a -> option a -> a val unsafeGet : a ::: Type -> option a -> a + +val mapM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> (a -> m b) -> t a -> m (t b) diff --git a/src/c/urweb.c b/src/c/urweb.c index ae2fc0a8..58f7884d 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1954,29 +1954,61 @@ char *uw_Basis_urlifyFloat(uw_context ctx, uw_Basis_float n) { return r; } +static void aux_urlifyChar(char** ptr, uw_Basis_char c) { + char* p = *ptr; + + if((uint32_t)(c) <= 0x7f) { + sprintf(p, ".%02X", (uint8_t)(c)); + p += 3; + } else { + if((uint32_t)(c) <= 0x7ff) { + sprintf(p, ".%02X", (uint8_t)(((c)>>6)|0xc0)); + p += 3; + } else { + if((uint32_t)(c) <= 0xffff) { + sprintf(p, ".%02X", (uint8_t)(((c)>>12)|0xe0)); + p += 3; + } else { + sprintf(p, ".%02X", (uint8_t)(((c)>>18)|0xf0)); + p += 3; + sprintf(p, ".%02X", (uint8_t)((((c)>>12)&0x3f)|0x80)); + p += 3; + } + sprintf(p, ".%02X", (uint8_t)((((c)>>6)&0x3f)|0x80)); + p += 3; + } + sprintf(p, ".%02X", (uint8_t)(((c)&0x3f)|0x80)); + p += 3; + } + + *ptr = p; +} + char *uw_Basis_urlifyString(uw_context ctx, uw_Basis_string s) { char *r, *p; if (s[0] == '\0') return "_"; - uw_check_heap(ctx, strlen(s) * 3 + 1 + !!(s[0] == '_')); + uw_check_heap(ctx, strlen(s) * 12 + 1 + !!(s[0] == '_')); r = p = ctx->heap.front; if (s[0] == '_') *p++ = '_'; - for (; *s; s++) { - unsigned char c = *s; - - if (c == ' ') + uw_Basis_char c; + int offset = 0, curr = 0; + while (s[offset] != 0) { + U8_NEXT(s, offset, -1, c); + + if (U8_IS_SINGLE(s[curr]) && s[curr] == ' ') *p++ = '+'; - else if (U8_IS_SINGLE(c) && isalnum(c)) - *p++ = c; + else if (U8_IS_SINGLE(s[curr]) && isalnum(s[curr])) + *p++ = s[curr]; else { - sprintf(p, ".%02X", c); - p += 3; + aux_urlifyChar(&p, c); } + curr = offset; } *p++ = 0; @@ -2046,6 +2078,29 @@ uw_unit uw_Basis_urlifyTime_w(uw_context ctx, uw_Basis_time t) { return uw_Basis_urlifyInt_w(ctx, (uw_Basis_int)t.seconds * 1000000 + t.microseconds); } +uw_unit uw_Basis_urlifyChar_w(uw_context ctx, uw_Basis_char c) { + if (c == '\0') { + uw_check(ctx, 1); + uw_writec_unsafe(ctx, '_'); + return uw_unit_v; + } + + uw_check(ctx, 12 + !!(c == '_')); + + if (c == '_') + uw_writec_unsafe(ctx, '_'); + + if (c == ' ') + uw_writec_unsafe(ctx, '+'); + else if (isalnum(c) && c <= 0x7f) + uw_writec_unsafe(ctx, c); + else { + aux_urlifyChar(&(ctx->page.front), c); + } + + return uw_unit_v; +} + uw_unit uw_Basis_urlifyString_w(uw_context ctx, uw_Basis_string s) { if (s[0] == '\0') { uw_check(ctx, 1); @@ -2053,22 +2108,24 @@ uw_unit uw_Basis_urlifyString_w(uw_context ctx, uw_Basis_string s) { return uw_unit_v; } - uw_check(ctx, strlen(s) * 3 + !!(s[0] == '_')); + uw_check(ctx, strlen(s) * 12 + !!(s[0] == '_')); if (s[0] == '_') uw_writec_unsafe(ctx, '_'); - for (; *s; s++) { - unsigned char c = *s; - - if (c == ' ') + uw_Basis_char c; + int offset = 0, curr = 0; + while (s[offset] != 0) { + U8_NEXT(s, offset, -1, c); + + if (U8_IS_SINGLE(s[curr]) && s[curr] == ' ') uw_writec_unsafe(ctx, '+'); - else if (U8_IS_SINGLE(c) && isalnum(c)) - uw_writec_unsafe(ctx, c); - else { - sprintf(ctx->page.front, ".%02X", c); - ctx->page.front += 3; + else if (U8_IS_SINGLE(s[curr]) && isalnum(s[curr])) + uw_writec_unsafe(ctx, s[curr]); + else { + aux_urlifyChar(&(ctx->page.front), c); } + curr = offset; } return uw_unit_v; @@ -4075,6 +4132,20 @@ uw_Basis_blob uw_Basis_textBlob(uw_context ctx, uw_Basis_string s) { return b; } +uw_Basis_string uw_Basis_textOfBlob(uw_context ctx, uw_Basis_blob b) { + size_t i; + uw_Basis_string r; + + for (i = 0; i < b.size; ++i) + if (b.data[i] == 0) + return NULL; + + r = uw_malloc(ctx, b.size + 1); + memcpy(r, b.data, b.size); + r[b.size] = 0; + return r; +} + uw_Basis_blob uw_Basis_fileData(uw_context ctx, uw_Basis_file f) { (void)ctx; return f.data; @@ -5207,7 +5278,7 @@ uw_unit uw_Basis_cache_file(uw_context ctx, uw_Basis_blob contents) { fd = mkstemp(tempfile); if (fd < 0) - uw_error(ctx, FATAL, "Error creating temporary file for cache"); + uw_error(ctx, FATAL, "Error creating temporary file %s for cache", tempfile); while (written_so_far < contents.size) { ssize_t written_just_now = write(fd, contents.data + written_so_far, contents.size - written_so_far); diff --git a/src/cjr_print.sml b/src/cjr_print.sml index 5983b9e5..d7416616 100644 --- a/src/cjr_print.sml +++ b/src/cjr_print.sml @@ -3393,6 +3393,14 @@ fun p_file env (ds, ps) = newline, string "#include <time.h>", newline, + (case Settings.getFileCache () of + NONE => box [] + | SOME _ => box [string "#include <sys/types.h>", + newline, + string "#include <sys/stat.h>", + newline, + string "#include <unistd.h>", + newline]), if hasDb then box [string ("#include <" ^ #header (Settings.currentDbms ()) ^ ">"), newline] @@ -3657,7 +3665,21 @@ fun p_file env (ds, ps) = newline, string "static void uw_initializer(uw_context ctx) {", newline, - box [string "uw_begin_initializing(ctx);", + box [(case Settings.getFileCache () of + NONE => box [] + | SOME dir => box [newline, + string "struct stat st = {0};", + newline, + newline, + string "if (stat(\"", + string (Prim.toCString dir), + string "\", &st) == -1)", + newline, + box [string "mkdir(\"", + string (Prim.toCString dir), + string "\", 0700);", + newline]]), + string "uw_begin_initializing(ctx);", newline, p_list_sep newline (fn x => x) (rev (!global_initializers)), string "uw_end_initializing(ctx);", diff --git a/src/mono_opt.sml b/src/mono_opt.sml index 40b865b0..cc85f05b 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -66,9 +66,9 @@ val htmlifyString = String.translate (fn #"<" => "<" fun htmlifySpecialChar ch = "&#" ^ Int.toString (ord ch) ^ ";" -fun hexIt ch = +fun hexPad c = let - val s = Int.fmt StringCvt.HEX (ord ch) + val s = Int.fmt StringCvt.HEX c in case size s of 0 => "00" @@ -76,6 +76,54 @@ fun hexIt ch = | _ => s end +fun rsh a b = + Int.fromLarge (IntInf.~>>(IntInf.fromInt a, Word.fromInt b)) + +fun orb a b = + Int.fromLarge (IntInf.orb(IntInf.fromInt a, IntInf.fromInt b)) + +fun andb a b = + Int.fromLarge (IntInf.andb(IntInf.fromInt a, IntInf.fromInt b)) + + +fun hexIt ch = + let + val c = ord ch + in + if (c <= 0x7f) then + hexPad c + else + ((if (c <= 0x7fff) then + hexPad (orb (rsh c 6) 0xc0) + else + (if (c <= 0xffff) then + hexPad (orb (rsh c 12) 0xe0) + else + hexPad (orb (rsh c 18) 0xf0) + ^ hexPad (orb (andb (rsh c 12) 0x3f) 0x80) + ) + ^ hexPad (orb (andb (rsh c 6) 0x3f) 0x80)) + ) ^ hexPad (orb (andb c 0x3f) 0x80) + end + +fun urlifyCharAux ch = + case ch of + #" " => "+" + | _ => + if ord ch = 0 then + "_" + else + if Char.isAlphaNum ch then + str ch + else + "." ^ hexIt ch + +fun urlifyChar c = + case c of + #"_" => "_" ^ urlifyCharAux c + | _ => urlifyCharAux c + + fun urlifyString s = case s of "" => "_" @@ -84,11 +132,7 @@ fun urlifyString s = "_" else "") - ^ String.translate (fn #" " => "+" - | ch => if Char.isAlphaNum ch then - str ch - else - "." ^ hexIt ch) s + ^ String.translate urlifyCharAux s fun sqlifyInt n = #p_cast (Settings.currentDbms ()) (attrifyInt n, Settings.Int) @@ -349,6 +393,13 @@ fun exp e = | EWrite (EFfiApp ("Basis", "urlifyString", [e]), _) => EFfiApp ("Basis", "urlifyString_w", [e]) + | EFfiApp ("Basis", "urlifyChar", [((EPrim (Prim.Char c), _), _)]) => + EPrim (Prim.String (Prim.Normal, urlifyChar c)) + | EWrite (EFfiApp ("Basis", "urlifyChar", [((EPrim (Prim.Char c), _), _)]), loc) => + EWrite (EPrim (Prim.String (Prim.Normal, urlifyChar c)), loc) + | EWrite (EFfiApp ("Basis", "urlifyChar", [e]), _) => + EFfiApp ("Basis", "urlifyChar_w", [e]) + | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "True", ...}, NONE), _), _)]) => EPrim (Prim.String (Prim.Normal, "1")) | EFfiApp ("Basis", "urlifyBool", [((ECon (Enum, PConFfi {con = "False", ...}, NONE), _), _)]) => diff --git a/src/settings.sml b/src/settings.sml index 0e999587..abb26f72 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -157,6 +157,7 @@ fun isEffectful ("Sqlcache", _) = true fun addEffectful x = effectful := S.add (!effectful, x) val benignBase = basis ["get_cookie", + "getenv", "new_client_source", "get_client_source", "set_client_source", diff --git a/tests/utf8.ur b/tests/utf8.ur index 4a89c22b..2150fde6 100644 --- a/tests/utf8.ur +++ b/tests/utf8.ur @@ -8,12 +8,47 @@ fun from_m_upto_n f m n = else <xml></xml> +fun from_m_upto_n2 (f : int -> transaction xbody) (m : int) (n : int) : transaction xbody = + if m < n then + h <- f m; + t <- from_m_upto_n2 f (m + 1) n; + return <xml> + { h } + { t } + </xml> + else + return <xml></xml> + fun test_fn_both_sides [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = <xml> <p>Server side test: {[testname]}</p> <pre>{[show (f () = expected)]}</pre> <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show (f () = expected)]}</pre></xml>}> </active> + </xml> + +fun test_fn_both_sides2 [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (serverexp : a) (expected : a) (testname : string) : xbody = +<xml> + <p>Test: {[testname]}</p> + <active code={ + let + val stest = (serverexp = expected) + in + return <xml> + <p>Server side test: {[testname]}</p> + <pre>{[show stest]}</pre> + {if stest then + <xml></xml> + else + <xml> + <p>S: {[serverexp]}</p> + <p>E: {[expected]}</p> + </xml>} + </xml> + end}> +</active> + <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show (f () = expected)]}</pre></xml>}> +</active> </xml> fun test_fn_sside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = @@ -22,12 +57,34 @@ fun test_fn_sside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected <pre>{[show (f () = expected)]}</pre> </xml> -fun test_fn_cside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = - <xml> - <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show (f () = expected)]}</pre></xml>}> - </active> - </xml> + fun test_fn_cside [a ::: Type] (_ : eq a) (_ : show a) (f : unit -> a) (expected : a) (testname : string) : xbody = + let + val r = f () + val v = r = expected + in + <xml> + <active code={return <xml><p>Client side test: {[testname]}</p><pre>{[show v]}</pre> + {if v then + <xml></xml> + else + <xml>Expected '{[show expected]}', is '{[show r]}'</xml>} + </xml>}> +</active> + </xml> + end +fun test_fn_cside_int (f : unit -> int) (expected : int) (testname : string) : xbody = + <xml> + <active code={let + val computed = f () + in + if computed = expected then + return <xml><p>{[testname]}</p><pre>True</pre></xml> + else + return <xml><p>{[testname]}</p><pre>False</pre></xml> + end}> +</active> + </xml> fun test_fn_cside_ch (f : unit -> char) (expected : char) (testname : string) : xbody = <xml> @@ -57,123 +114,297 @@ fun test_fn_cside_b (f : unit -> bool) (expected : bool) (testname : string) : x return <xml><p>ERROR {[testname]}: {[msgErr]}</p></xml> end}> </active> -</xml> + </xml> +fun generateTests _ = + return { SL1 = (strlen "ππππ"), + SL2 = (strlen "πππ"), + SL3 = (strlen "ππ"), + SL4 = (strlen "π"), + SS1 = (substring "ππππ" 1 3), + SS2 = (substring "ππππ" 2 2), + SS3 = (substring "ππππ" 3 1) , + SLSS1 = (strlen (substring "ππππ" 1 3)), + SLSS2 = (strlen (substring "ππππ" 2 2)), + SLSS3 = (strlen (substring "ππππ" 3 1)), + + SSB1 = (strsub "ππππ" 0), + SSB2 = (strsub "ππππ" 1), + SSB3 = (strsub "ππππ" 2), + SSB4 = (strsub "ππππ" 3), + + SSF1 = (strsuffix "ππππ" 0), + SSF2 = (strsuffix "ππππ" 1), + SSF3 = (strsuffix "ππππ" 2), + SSF4 = (strsuffix "ππππ" 3), + + SC1 = (strchr "ππππ" #"c"), + SC2 = (strchr "ππππ" (strsub "π" 0)), + SC3 = (strchr "ππππ" (strsub "π" 0)), + SC4 = (strchr "ππππ" (strsub "π" 0)), + SC5 = (strchr "ππππ" (strsub "π" 0)), + + SI1 = (strindex "ππππ" #"c"), + SI2 = (strindex "ππππ" (strsub "π" 0)), + SI3 = (strindex "ππππ" (strsub "π" 0)), + SI4 = (strindex "ππππ" (strsub "π" 0)), + SI5 = (strindex "ππππ" (strsub "π" 0)), + + SSI1 = (strsindex "ππππ" ""), + SSI2 = (strsindex "ππππ" "ππππ"), + SSI3 = (strsindex "ππππ" "πππc"), + SSI4 = (strsindex "ππππ" "πππ"), + SSI5 = (strsindex "ππππ" "ππc"), + SSI6 = (strsindex "ππππ" "ππ"), + SSI7 = (strsindex "ππππ" "πc"), + SSI8 = (strsindex "ππππ" "π"), + SSI9 = (strsindex "ππππ" "c"), + + SCSP1 = (strcspn "ππππ" ""), + SCSP2 = (strcspn "ππππ" "ππππ"), + SCSP3 = (strcspn "ππππ" "π"), + SCSP4 = (strcspn "ππππ" "πππ"), + SCSP5 = (strcspn "ππππ" "ππ"), + SCSP6 = (strcspn "ππππ" "π"), + + OSS1 = (ord (strsub "ππππ" 0)), + OSS2 = (ord (strsub "ππππ" 1)), + OSS3 = (ord (strsub "ππππ" 2)), + OSS4 = (ord (strsub "ππππ" 3)), + + SSS1 = (show (strsub "ππππ" 0)), + SSS2 = (show (strsub "ππππ" 1)), + SSS3 = (show (strsub "ππππ" 2)), + SSS4 = (show (strsub "ππππ" 3)) + } fun highencode () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_cside (fn _ => strlen "ππππ") (strlen "ππππ") "high encode - strlen 1"} - {test_fn_cside (fn _ => strlen "πππ") (strlen "πππ") "high encode - strlen 2"} - {test_fn_cside (fn _ => strlen "ππ") (strlen "ππ") "high encode - strlen 3"} - {test_fn_cside (fn _ => strlen "π") (strlen "π") "high encode - strlen 4"} - - {test_fn_cside (fn _ => substring "ππππ" 1 3) (substring "ππππ" 1 3) "high encode - substring 1"} - {test_fn_cside (fn _ => substring "ππππ" 2 2) (substring "ππππ" 2 2) "high encode - substring 2"} - {test_fn_cside (fn _ => substring "ππππ" 3 1) (substring "ππππ" 3 1) "high encode - substring 3"} - - {test_fn_cside (fn _ => strlen (substring "ππππ" 1 3)) (strlen (substring "ππππ" 1 3)) "high encode - strlen of substring 1"} - {test_fn_cside (fn _ => strlen (substring "ππππ" 2 2)) (strlen (substring "ππππ" 2 2)) "high encode - strlen of substring 2"} - {test_fn_cside (fn _ => strlen (substring "ππππ" 3 1)) (strlen (substring "ππππ" 3 1)) "high encode - strlen of substring 3"} - - {test_fn_cside (fn _ => strsub "ππππ" 0) (strsub "ππππ" 0) "high encode - strsub 1"} - {test_fn_cside (fn _ => strsub "ππππ" 1) (strsub "ππππ" 1) "high encode - strsub 2"} - {test_fn_cside (fn _ => strsub "ππππ" 2) (strsub "ππππ" 2) "high encode - strsub 3"} - {test_fn_cside (fn _ => strsub "ππππ" 3) (strsub "ππππ" 3) "high encode - strsub 4"} - - {test_fn_cside (fn _ => strsuffix "ππππ" 0) (strsuffix "ππππ" 0) "high encode - strsuffix 1"} - {test_fn_cside (fn _ => strsuffix "ππππ" 1) (strsuffix "ππππ" 1) "high encode - strsuffix 2"} - {test_fn_cside (fn _ => strsuffix "ππππ" 2) (strsuffix "ππππ" 2) "high encode - strsuffix 3"} - {test_fn_cside (fn _ => strsuffix "ππππ" 3) (strsuffix "ππππ" 3) "high encode - strsuffix 4"} - - {test_fn_cside (fn _ => strchr "ππππ" #"c") (strchr "ππππ" #"c") "high encode - strchr 1"} - {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) (strchr "ππππ" (strsub "π" 0)) "high encode - strchr 2"} - {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) (strchr "ππππ" (strsub "π" 0)) "high encode - strchr 3"} - {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) (strchr "ππππ" (strsub "π" 0)) "high encode - strchr 4"} - {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) (strchr "ππππ" (strsub "π" 0)) "high encode - strchr 5"} - - {test_fn_cside (fn _ => strindex "ππππ" #"c") (strindex "ππππ" #"c") "high encode - strindex 1"} - {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) (strindex "ππππ" (strsub "π" 0)) "high encode - strindex 2"} - {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) (strindex "ππππ" (strsub "π" 0)) "high encode - strindex 3"} - {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) (strindex "ππππ" (strsub "π" 0)) "high encode - strindex 4"} - {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) (strindex "ππππ" (strsub "π" 0)) "high encode - strindex 5"} - - {test_fn_cside (fn _ => strsindex "ππππ" "") (strsindex "ππππ" "") "high encode - strsindex 1"} - {test_fn_cside (fn _ => strsindex "ππππ" "ππππ") (strsindex "ππππ" "ππππ") "high encode - strsindex 2"} - {test_fn_cside (fn _ => strsindex "ππππ" "πππc") (strsindex "ππππ" "πππc") "high encode - strsindex 3"} - {test_fn_cside (fn _ => strsindex "ππππ" "πππ") (strsindex "ππππ" "πππ") "high encode - strsindex 4"} - {test_fn_cside (fn _ => strsindex "ππππ" "ππc") (strsindex "ππππ" "ππc") "high encode - strsindex 5"} - {test_fn_cside (fn _ => strsindex "ππππ" "ππ") (strsindex "ππππ" "ππ") "high encode - strsindex 6"} - {test_fn_cside (fn _ => strsindex "ππππ" "πc") (strsindex "ππππ" "πc") "high encode - strsindex 7"} - {test_fn_cside (fn _ => strsindex "ππππ" "π") (strsindex "ππππ" "π") "high encode - strsindex 8"} - {test_fn_cside (fn _ => strsindex "ππππ" "c") (strsindex "ππππ" "c") "high encode - strsindex 9"} - - {test_fn_cside (fn _ => strcspn "ππππ" "") (strcspn "ππππ" "") "high encode - strcspn 1"} - {test_fn_cside (fn _ => strcspn "ππππ" "ππππ") (strcspn "ππππ" "ππππ") "high encode - strcspn 2"} - {test_fn_cside (fn _ => strcspn "ππππ" "π") (strcspn "ππππ" "π") "high encode - strcspn 3"} - {test_fn_cside (fn _ => strcspn "ππππ" "πππ") (strcspn "ππππ" "πππ") "high encode - strcspn 4"} - {test_fn_cside (fn _ => strcspn "ππππ" "ππ") (strcspn "ππππ" "ππ") "high encode - strcspn 5"} - {test_fn_cside (fn _ => strcspn "ππππ" "π") (strcspn "ππππ" "π") "high encode - strcspn 6"} - - {test_fn_cside (fn _ => ord (strsub "ππππ" 0)) (ord (strsub "ππππ" 0)) "high encode - ord 1"} - {test_fn_cside (fn _ => ord (strsub "ππππ" 1)) (ord (strsub "ππππ" 1)) "high encode - ord 2"} - {test_fn_cside (fn _ => ord (strsub "ππππ" 2)) (ord (strsub "ππππ" 2)) "high encode - ord 3"} - {test_fn_cside (fn _ => ord (strsub "ππππ" 3)) (ord (strsub "ππππ" 3)) "high encode - ord 4"} + <body onload={tests <- rpc (generateTests ()); set t (Some tests); return ()}> + + <dyn signal={tests' <- signal t; + case tests' of + None => return <xml></xml> + | Some tests => return <xml> + + {test_fn_cside (fn _ => strlen "ππππ") tests.SL1 "high encode - strlen 1"} + {test_fn_cside (fn _ => strlen "πππ") tests.SL2 "high encode - strlen 2"} + {test_fn_cside (fn _ => strlen "ππ") tests.SL3 "high encode - strlen 3"} + {test_fn_cside (fn _ => strlen "π") tests.SL4 "high encode - strlen 4"} + + {test_fn_cside (fn _ => substring "ππππ" 1 3) tests.SS1 "high encode - substring 1"} + {test_fn_cside (fn _ => substring "ππππ" 2 2) tests.SS2 "high encode - substring 2"} + {test_fn_cside (fn _ => substring "ππππ" 3 1) tests.SS3 "high encode - substring 3"} - {test_fn_cside (fn _ => show (strsub "ππππ" 0)) (show (strsub "ππππ" 0)) "high encode - show 1"} - {test_fn_cside (fn _ => show (strsub "ππππ" 1)) (show (strsub "ππππ" 1)) "high encode - show 2"} - {test_fn_cside (fn _ => show (strsub "ππππ" 2)) (show (strsub "ππππ" 2)) "high encode - show 3"} - {test_fn_cside (fn _ => show (strsub "ππππ" 3)) (show (strsub "ππππ" 3)) "high encode - show 4"} + {test_fn_cside (fn _ => strlen (substring "ππππ" 1 3)) tests.SLSS1 "high encode - strlen of substring 1"} + {test_fn_cside (fn _ => strlen (substring "ππππ" 2 2)) tests.SLSS2 "high encode - strlen of substring 2"} + {test_fn_cside (fn _ => strlen (substring "ππππ" 3 1)) tests.SLSS3 "high encode - strlen of substring 3"} + + {test_fn_cside (fn _ => strsub "ππππ" 0) tests.SSB1 "high encode - strsub 1"} + {test_fn_cside (fn _ => strsub "ππππ" 1) tests.SSB2 "high encode - strsub 2"} + {test_fn_cside (fn _ => strsub "ππππ" 2) tests.SSB3 "high encode - strsub 3"} + {test_fn_cside (fn _ => strsub "ππππ" 3) tests.SSB4 "high encode - strsub 4"} + + {test_fn_cside (fn _ => strsuffix "ππππ" 0) tests.SSF1 "high encode - strsuffix 1"} + {test_fn_cside (fn _ => strsuffix "ππππ" 1) tests.SSF2 "high encode - strsuffix 2"} + {test_fn_cside (fn _ => strsuffix "ππππ" 2) tests.SSF3 "high encode - strsuffix 3"} + {test_fn_cside (fn _ => strsuffix "ππππ" 3) tests.SSF4 "high encode - strsuffix 4"} + + {test_fn_cside (fn _ => strchr "ππππ" #"c") tests.SC1 "high encode - strchr 1"} + {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) tests.SC2 "high encode - strchr 2"} + {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) tests.SC3 "high encode - strchr 3"} + {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) tests.SC4 "high encode - strchr 4"} + {test_fn_cside (fn _ => strchr "ππππ" (strsub "π" 0)) tests.SC5 "high encode - strchr 5"} + + {test_fn_cside (fn _ => strindex "ππππ" #"c") tests.SI1 "high encode - strindex 1"} + {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) tests.SI2 "high encode - strindex 2"} + {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) tests.SI3 "high encode - strindex 3"} + {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) tests.SI4 "high encode - strindex 4"} + {test_fn_cside (fn _ => strindex "ππππ" (strsub "π" 0)) tests.SI5 "high encode - strindex 5"} + + {test_fn_cside (fn _ => strsindex "ππππ" "") tests.SSI1 "high encode - strsindex 1"} + {test_fn_cside (fn _ => strsindex "ππππ" "ππππ") tests.SSI2 "high encode - strsindex 2"} + {test_fn_cside (fn _ => strsindex "ππππ" "πππc") tests.SSI3 "high encode - strsindex 3"} + {test_fn_cside (fn _ => strsindex "ππππ" "πππ") tests.SSI4 "high encode - strsindex 4"} + {test_fn_cside (fn _ => strsindex "ππππ" "ππc") tests.SSI5 "high encode - strsindex 5"} + {test_fn_cside (fn _ => strsindex "ππππ" "ππ") tests.SSI6 "high encode - strsindex 6"} + {test_fn_cside (fn _ => strsindex "ππππ" "πc") tests.SSI7 "high encode - strsindex 7"} + {test_fn_cside (fn _ => strsindex "ππππ" "π") tests.SSI8 "high encode - strsindex 8"} + {test_fn_cside (fn _ => strsindex "ππππ" "c") tests.SSI9 "high encode - strsindex 9"} + + {test_fn_cside (fn _ => strcspn "ππππ" "") tests.SCSP1 "high encode - strcspn 1"} + {test_fn_cside (fn _ => strcspn "ππππ" "ππππ") tests.SCSP2 "high encode - strcspn 2"} + {test_fn_cside (fn _ => strcspn "ππππ" "π") tests.SCSP3 "high encode - strcspn 3"} + {test_fn_cside (fn _ => strcspn "ππππ" "πππ") tests.SCSP4 "high encode - strcspn 4"} + {test_fn_cside (fn _ => strcspn "ππππ" "ππ") tests.SCSP5 "high encode - strcspn 5"} + {test_fn_cside (fn _ => strcspn "ππππ" "π") tests.SCSP6 "high encode - strcspn 6"} + + {test_fn_cside (fn _ => ord (strsub "ππππ" 0)) tests.OSS1 "high encode - ord 1"} + {test_fn_cside (fn _ => ord (strsub "ππππ" 1)) tests.OSS2 "high encode - ord 2"} + {test_fn_cside (fn _ => ord (strsub "ππππ" 2)) tests.OSS3 "high encode - ord 3"} + {test_fn_cside (fn _ => ord (strsub "ππππ" 3)) tests.OSS4 "high encode - ord 4"} + + {test_fn_cside (fn _ => show (strsub "ππππ" 0)) tests.SSS1 "high encode - show 1"} + {test_fn_cside (fn _ => show (strsub "ππππ" 1)) tests.SSS2 "high encode - show 2"} + {test_fn_cside (fn _ => show (strsub "ππππ" 2)) tests.SSS3 "high encode - show 3"} + {test_fn_cside (fn _ => show (strsub "ππππ" 3)) tests.SSS4 "high encode - show 4"} + + </xml> } /> </body> - </xml> + </xml> + +(* substrings *) +fun substring1 _ = substring "abc" 0 3 +fun substring2 _ = substring "abc" 1 2 +fun substring3 _ = substring "abc" 2 1 +fun substring4 _ = substring "Γ‘bΓ³" 0 3 +fun substring5 _ = substring "Γ‘bΓ³" 1 2 +fun substring6 _ = substring "Γ‘bΓ³" 2 1 +fun substring7 _ = substring "Γ‘bΓ³" 0 2 +fun substring8 _ = substring "Γ‘bΓ³" 0 1 +fun substring9 _ = substring "" 0 0 +fun substringsserver _ = + return { + T1 = substring1 (), + T2 = substring2 (), + T3 = substring3 (), + T4 = substring4 (), + T5 = substring5 (), + T6 = substring6 (), + T7 = substring7 (), + T8 = substring8 (), + T9 = substring9 () + } + fun substrings () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => substring "abc" 0 3) "abc" "substrings 1"} - {test_fn_both_sides (fn _ => substring "abc" 1 2) "bc" "substrings 2"} - {test_fn_both_sides (fn _ => substring "abc" 2 1) "c" "substrings 3"} - {test_fn_both_sides (fn _ => substring "Γ‘bΓ³" 0 3) "Γ‘bΓ³" "substrings 4"} - {test_fn_both_sides (fn _ => substring "Γ‘bΓ³" 1 2) "bΓ³" "substrings 5"} - {test_fn_both_sides (fn _ => substring "Γ‘bΓ³" 2 1) "Γ³" "substrings 6"} - {test_fn_both_sides (fn _ => substring "Γ‘bΓ³" 0 2) "Γ‘b" "substrings 7"} - {test_fn_both_sides (fn _ => substring "Γ‘bΓ³" 0 1) "Γ‘" "substrings 8"} - {test_fn_both_sides (fn _ => substring "" 0 0) "" "substrings 9"} + <body onload={r <- rpc (substringsserver ()); + set t (Some r); + return () }> + + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => + return <xml> + {test_fn_both_sides2 substring1 t'.T1 "abc" "substrings 1"} + {test_fn_both_sides2 substring2 t'.T2 "bc" "substrings 2"} + {test_fn_both_sides2 substring3 t'.T3 "c" "substrings 3"} + {test_fn_both_sides2 substring4 t'.T4 "Γ‘bΓ³" "substrings 4"} + {test_fn_both_sides2 substring5 t'.T5 "bΓ³" "substrings 5"} + {test_fn_both_sides2 substring6 t'.T6 "Γ³" "substrings 6"} + {test_fn_both_sides2 substring7 t'.T7 "Γ‘b" "substrings 7"} + {test_fn_both_sides2 substring8 t'.T8 "Γ‘" "substrings 8"} + {test_fn_both_sides2 substring9 t'.T9 "" "substrings 9"} + </xml> + } /> </body> </xml> +(* strlen *) +fun strlen1 _ = strlen "abc" +fun strlen2 _ = strlen "Γ§bc" +fun strlen3 _ = strlen "çãc" +fun strlen4 _ = strlen "çãó" +fun strlen5 _ = strlen "Γ§" +fun strlen6 _ = strlen "c" +fun strlen7 _ = strlen "" +fun strlen8 _ = strlen "γ" +fun strlen9 _ = strlen "ζΌ’" +fun strlen10 _ = strlen "γ«" +fun strlen11 _ = strlen "ΩΨΈΩΩΩΨ©" +fun strlen12 _ = strlen "ε½ζΈ" +fun strlen13 _ = strlen "Π€ΡΠ½ΠΊΡΠΈΠΎΠ½Π°Π»ΡΠ½ΠΎΠ΅" + +fun strlensserver _ = + return { + T1 = strlen1 (), + T2 = strlen2 (), + T3 = strlen3 (), + T4 = strlen4 (), + T5 = strlen5 (), + T6 = strlen6 (), + T7 = strlen7 (), + T8 = strlen8 (), + T9 = strlen9 (), + T10 = strlen10 (), + T11 = strlen11 (), + T12 = strlen12 (), + T13 = strlen13 () + } + +fun strlens () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strlensserver()); + set t (Some r); + return ()}> + + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => + return <xml> + {test_fn_both_sides2 strlen1 t'.T1 3 "strlen 1"} + {test_fn_both_sides2 strlen2 t'.T2 3 "strlen 2"} + {test_fn_both_sides2 strlen3 t'.T3 3 "strlen 3"} + {test_fn_both_sides2 strlen4 t'.T4 3 "strlen 4"} + {test_fn_both_sides2 strlen5 t'.T5 1 "strlen 5"} + {test_fn_both_sides2 strlen6 t'.T6 1 "strlen 6"} + {test_fn_both_sides2 strlen7 t'.T7 0 "strlen 7"} + {test_fn_both_sides2 strlen8 t'.T8 1 "strlen 8"} + {test_fn_both_sides2 strlen9 t'.T9 1 "strlen 9"} + {test_fn_both_sides2 strlen10 t'.T10 1 "strlen 10"} + {test_fn_both_sides2 strlen11 t'.T11 6 "strlen 11"} + {test_fn_both_sides2 strlen12 t'.T12 2 "strlen 12"} + {test_fn_both_sides2 strlen13 t'.T13 14 "strlen 13"} + </xml>} /> -fun strlens () : transaction page = return <xml> - <body> - {test_fn_both_sides (fn _ => strlen "abc") 3 "strlen 1"} - {test_fn_both_sides (fn _ => strlen "Γ§bc") 3 "strlen 2"} - {test_fn_both_sides (fn _ => strlen "çãc") 3 "strlen 3"} - {test_fn_both_sides (fn _ => strlen "çãó") 3 "strlen 4"} - {test_fn_both_sides (fn _ => strlen "Γ§") 1 "strlen 5"} - {test_fn_both_sides (fn _ => strlen "c") 1 "strlen 6"} - {test_fn_both_sides (fn _ => strlen "") 0 "strlen 7"} - {test_fn_both_sides (fn _ => strlen "γ") 1 "strlen 8"} - {test_fn_both_sides (fn _ => strlen "ζΌ’") 1 "strlen 9"} - {test_fn_both_sides (fn _ => strlen "γ«") 1 "strlen 10"} - {test_fn_both_sides (fn _ => strlen "ΩΨΈΩΩΩΨ©") 6 "strlen 11"} - {test_fn_both_sides (fn _ => strlen "ε½ζΈ") 2 "strlen 12"} - {test_fn_both_sides (fn _ => strlen "Π€ΡΠ½ΠΊΡΠΈΠΎΠ½Π°Π»ΡΠ½ΠΎΠ΅") 14 "strlen 13"} - </body> - </xml> - -fun strlenGens () : transaction page = return <xml> - <body> - {test_fn_both_sides (fn _ => strlenGe "" 1) False "strlenGe 1"} - {test_fn_both_sides (fn _ => strlenGe "" 0) True "strlenGe 2"} - {test_fn_both_sides (fn _ => strlenGe "aba" 4) False "strlenGe 3"} - {test_fn_both_sides (fn _ => strlenGe "aba" 3) True "strlenGe 4"} - {test_fn_both_sides (fn _ => strlenGe "aba" 2) True "strlenGe 5"} - {test_fn_both_sides (fn _ => strlenGe "à çÑ" 4) False "strlenGe 6"} - {test_fn_both_sides (fn _ => strlenGe "à çÑ" 3) True "strlenGe 7"} - {test_fn_both_sides (fn _ => strlenGe "à çÑ" 2) True "strlenGe 8"} </body> - </xml> + </xml> + +(* strlenGe *) +fun strlenGe1 _ = strlenGe "" 1 +fun strlenGe2 _ = strlenGe "" 0 +fun strlenGe3 _ = strlenGe "aba" 4 +fun strlenGe4 _ = strlenGe "aba" 3 +fun strlenGe5 _ = strlenGe "aba" 2 +fun strlenGe6 _ = strlenGe "à çÑ" 4 +fun strlenGe7 _ = strlenGe "à çÑ" 3 +fun strlenGe8 _ = strlenGe "à çÑ" 2 + +fun strleGesserver _ = return { + T1 = strlenGe1 (), + T2 = strlenGe2 (), + T3 = strlenGe3 (), + T4 = strlenGe4 (), + T5 = strlenGe5 (), + T6 = strlenGe6 (), + T7 = strlenGe7 (), + T8 = strlenGe8 () + } + +fun strlenGens () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (strleGesserver()); + set t (Some r); + return ()}> + + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => + return <xml> + {test_fn_both_sides2 strlenGe1 t'.T1 False "strlenGe 1"} + {test_fn_both_sides2 strlenGe2 t'.T2 True "strlenGe 2"} + {test_fn_both_sides2 strlenGe3 t'.T3 False "strlenGe 3"} + {test_fn_both_sides2 strlenGe4 t'.T4 True "strlenGe 4"} + {test_fn_both_sides2 strlenGe5 t'.T5 True "strlenGe 5"} + {test_fn_both_sides2 strlenGe6 t'.T6 False "strlenGe 6"} + {test_fn_both_sides2 strlenGe7 t'.T7 True "strlenGe 7"} + {test_fn_both_sides2 strlenGe8 t'.T8 True "strlenGe 8"} + </xml>} /> + </body> + </xml> type clen = { S : string, L : int } @@ -182,181 +413,530 @@ val clen_eq : eq clen = mkEq (fn a b => val clen_show : show clen = mkShow (fn a => "{S = " ^ a.S ^ ", L = " ^ (show a.L) ^ "}") +(* strcat *) + +fun teststrcat a b = let val c = strcat a b in {S = c, L = strlen c} end +fun teststrcat1 _ = teststrcat "" "" +fun teststrcat2 _ = teststrcat "aa" "bb" +fun teststrcat3 _ = teststrcat "" "bb" +fun teststrcat4 _ = teststrcat "aa" "" +fun teststrcat5 _ = teststrcat "Γ Γ " "ÑÑ" +fun teststrcat6 _ = teststrcat "" "ÑÑ" +fun teststrcat7 _ = teststrcat "Γ Γ " "" +fun teststrcat8 _ = teststrcat "ε½ζΈ" "ãã" +fun teststrcat9 _ = teststrcat "Γ§" "Γ£" +fun teststrcat10 _ = teststrcat (show (strsub "Γ§" 0)) (show (strsub "Γ£" 0)) +fun teststrcat11 _ = teststrcat (show (chr 231)) (show (chr 227)) +fun strcatsserver () = + return { + T1 = teststrcat1 (), + T2 = teststrcat2 (), + T3 = teststrcat3 (), + T4 = teststrcat4 (), + T5 = teststrcat5 (), + T6 = teststrcat6 (), + T7 = teststrcat7 (), + T8 = teststrcat8 (), + T9 = teststrcat9 (), + T10 = teststrcat10 (), + T11 = teststrcat11 () + } + fun strcats () : transaction page = - let - fun test_cat_and_len n a b expS expL = - test_fn_both_sides (fn _ => let val c = strcat a b in {S = c, L = strlen c} end) {S=expS, L=expL} ("strcat " ^ (show n)) - in - return <xml> - <body> - {test_cat_and_len 1 "" "" "" 0} - {test_cat_and_len 2 "aa" "bb" "aabb" 4} - {test_cat_and_len 3 "" "bb" "bb" 2} - {test_cat_and_len 4 "aa" "" "aa" 2} - {test_cat_and_len 5 "Γ Γ " "ÑÑ" "à à ÑÑ" 4} - {test_cat_and_len 6 "" "ÑÑ" "ÑÑ" 2} - {test_cat_and_len 7 "Γ Γ " "" "Γ Γ " 2} - {test_cat_and_len 8 "ε½ζΈ" "ãã" "ε½ζΈΓ£Γ£" 4} - {test_cat_and_len 9 "Γ§" "Γ£" "çã" 2} - {test_cat_and_len 10 (show (strsub "Γ§" 0)) (show (strsub "Γ£" 0)) "çã" 2} - {test_cat_and_len 11 (show (chr 231)) (show (chr 227)) "çã" 2} - </body> - </xml> -end + t <- source None; + return <xml> + <body onload={r <- rpc (strcatsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 teststrcat1 t'.T1 {S="",L=0} "strcat 1" } + {test_fn_both_sides2 teststrcat2 t'.T2 {S="aabb",L=4} "strcat 2" } + {test_fn_both_sides2 teststrcat3 t'.T3 {S="bb",L=2} "strcat 3" } + {test_fn_both_sides2 teststrcat4 t'.T4 {S="aa",L=2} "strcat 4" } + {test_fn_both_sides2 teststrcat5 t'.T5 {S="à à ÑÑ",L=4} "strcat 5" } + {test_fn_both_sides2 teststrcat6 t'.T6 {S="ÑÑ",L=2} "strcat 6" } + {test_fn_both_sides2 teststrcat7 t'.T7 {S="Γ Γ ",L=2} "strcat 7" } + {test_fn_both_sides2 teststrcat8 t'.T8 {S="ε½ζΈΓ£Γ£",L=4} "strcat 8" } + {test_fn_both_sides2 teststrcat9 t'.T9 {S="çã",L=2} "strcat 9" } + {test_fn_both_sides2 teststrcat10 t'.T10 {S="çã",L=2} "strcat 10" } + {test_fn_both_sides2 teststrcat11 t'.T11 {S="çã",L=2} "strcat 11" } + </xml>} /> + </body> + </xml> + +(* strsubs *) +fun strsub1 _ = strsub "abΓ Γ§" 0 +fun strsub2 _ = strsub "abΓ Γ§" 1 +fun strsub3 _ = strsub "Γ b" 0 +fun strsub4 _ = strsub "abΓ Γ§" 2 +fun strsub5 _ = strsub "abΓ Γ§" 3 + +fun strsubsserver _ = return { + T1 = strsub1 (), + T2 = strsub2 (), + T3 = strsub3 (), + T4 = strsub4 (), + T5 = strsub5 () + } + fun strsubs () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => strsub "abΓ Γ§" 0) #"a" "strsub 1"} - {test_fn_both_sides (fn _ => strsub "abΓ Γ§" 1) #"b" "strsub 2"} - {test_fn_both_sides (fn _ => strsub "Γ b" 0) (strsub "Γ " 0) "strsub 3"} - {test_fn_both_sides (fn _ => strsub "abΓ Γ§" 2) (strsub "Γ " 0) "strsub 4"} - {test_fn_both_sides (fn _ => strsub "abΓ Γ§" 3) (strsub "Γ§" 0) "strsub 5"} + <body onload={r <- rpc (strsubsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strsub1 t'.T1 #"a" "strsub 1"} + {test_fn_both_sides2 strsub2 t'.T2 #"b" "strsub 2"} + {test_fn_both_sides2 strsub3 t'.T3 (strsub "Γ " 0) "strsub 3"} + {test_fn_both_sides2 strsub4 t'.T4 (strsub "Γ " 0) "strsub 4"} + {test_fn_both_sides2 strsub5 t'.T5 (strsub "Γ§" 0) "strsub 5"} + </xml> + } /> + </body> - </xml> + </xml> +(* strsuffixs *) +fun strsuffix1 _ = strsuffix "abΓ Γ§" 0 +fun strsuffix2 _ = strsuffix "abΓ Γ§" 1 +fun strsuffix3 _ = strsuffix "abΓ Γ§" 2 +fun strsuffix4 _ = strsuffix "abΓ Γ§" 3 + +fun strsuffixsserver _ = + return { + T1 = strsuffix1 (), + T2 = strsuffix2 (), + T3 = strsuffix3 (), + T4 = strsuffix4 () + } + fun strsuffixs () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => strsuffix "abΓ Γ§" 0) "abΓ Γ§" "strsuffix 1"} - {test_fn_both_sides (fn _ => strsuffix "abΓ Γ§" 1) "bΓ Γ§" "strsuffix 2"} - {test_fn_both_sides (fn _ => strsuffix "abΓ Γ§" 2) "Γ Γ§" "strsuffix 3"} - {test_fn_both_sides (fn _ => strsuffix "abΓ Γ§" 3) "Γ§" "strsuffix 4"} + <body onload={r <- rpc (strsuffixsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strsuffix1 t'.T1 "abΓ Γ§" "strsuffix 1"} + {test_fn_both_sides2 strsuffix2 t'.T2 "bΓ Γ§" "strsuffix 2"} + {test_fn_both_sides2 strsuffix3 t'.T3 "Γ Γ§" "strsuffix 3"} + {test_fn_both_sides2 strsuffix4 t'.T4 "Γ§" "strsuffix 4"} + </xml> + } /> + </body> </xml> +(* strchrs *) + +fun strchr1 _ = strchr "abΓ Γ§" #"c" +fun strchr2 _ = strchr "abΓ Γ§" #"a" +fun strchr3 _ = strchr "abΓ Γ§" #"b" +fun strchr4 _ = strchr "abΓ Γ§" (strsub "Γ " 0) +fun strchr5 _ = strchr "abΓ Γ§" (strsub "Γ§" 0) + +fun strchrssserver _ = + return { + T1 = strchr1 (), + T2 = strchr2 (), + T3 = strchr3 (), + T4 = strchr4 (), + T5 = strchr5 () + } + fun strchrs () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => strchr "abΓ Γ§" #"c") None "strchr 1"} - {test_fn_both_sides (fn _ => strchr "abΓ Γ§" #"a") (Some "abΓ Γ§") "strchr 2"} - {test_fn_both_sides (fn _ => strchr "abΓ Γ§" #"b") (Some "bΓ Γ§") "strchr 3"} - {test_fn_both_sides (fn _ => strchr "abΓ Γ§" (strsub "Γ " 0)) (Some "Γ Γ§") "strchr 4"} - {test_fn_both_sides (fn _ => strchr "abΓ Γ§" (strsub "Γ§" 0)) (Some "Γ§") "strchr 5"} + <body onload={r <- rpc (strchrssserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strchr1 t'.T1 None "strchr 1"} + {test_fn_both_sides2 strchr2 t'.T2 (Some "abΓ Γ§") "strchr 2"} + {test_fn_both_sides2 strchr3 t'.T3 (Some "bΓ Γ§") "strchr 3"} + {test_fn_both_sides2 strchr4 t'.T4 (Some "Γ Γ§") "strchr 4"} + {test_fn_both_sides2 strchr5 t'.T5 (Some "Γ§") "strchr 5"} + </xml> + } /> + </body> - </xml> + </xml> + +(* strindexs *) +fun strindex1 _ = strindex "abΓ Γ§" #"c" +fun strindex2 _ = strindex "abΓ Γ§" #"a" +fun strindex3 _ = strindex "abΓ Γ§" #"b" +fun strindex4 _ = strindex "abΓ Γ§" (strsub "Γ " 0) +fun strindex5 _ = strindex "abΓ Γ§" (strsub "Γ§" 0) +fun strindexsserver _ = + return { + T1 = strindex1 (), + T2 = strindex2 (), + T3 = strindex3 (), + T4 = strindex4 (), + T5 = strindex5 () + } + fun strindexs () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => strindex "abΓ Γ§" #"c") None "strindex 1"} - {test_fn_both_sides (fn _ => strindex "abΓ Γ§" #"a") (Some 0) "strindex 2"} - {test_fn_both_sides (fn _ => strindex "abΓ Γ§" #"b") (Some 1) "strindex 3"} - {test_fn_both_sides (fn _ => strindex "abΓ Γ§" (strsub "Γ " 0)) (Some 2) "strindex 4"} - {test_fn_both_sides (fn _ => strindex "abΓ Γ§" (strsub "Γ§" 0)) (Some 3) "strindex 5"} + <body onload={r <- rpc (strindexsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strindex1 t'.T1 None "strindex 1"} + {test_fn_both_sides2 strindex2 t'.T2 (Some 0) "strindex 2"} + {test_fn_both_sides2 strindex3 t'.T3 (Some 1) "strindex 3"} + {test_fn_both_sides2 strindex4 t'.T4 (Some 2) "strindex 4"} + {test_fn_both_sides2 strindex5 t'.T5 (Some 3) "strindex 5"} + </xml> + } /> + </body> </xml> +(*strsindexs*) +fun strsindex1 _ = strsindex "abΓ Γ§" "" +fun strsindex2 _ = strsindex "abΓ Γ§" "abΓ Γ§" +fun strsindex3 _ = strsindex "abΓ Γ§" "abΓ c" +fun strsindex4 _ = strsindex "abΓ Γ§" "bΓ Γ§" +fun strsindex5 _ = strsindex "abΓ Γ§" "bΓ c" +fun strsindex6 _ = strsindex "abΓ Γ§" "Γ Γ§" +fun strsindex7 _ = strsindex "abΓ Γ§" "Γ c" +fun strsindex8 _ = strsindex "abΓ Γ§" "Γ§" +fun strsindex9 _ = strsindex "abΓ Γ§" "c" + +fun strsindexsserver _ = + return { + T1 = strsindex1 (), + T2 = strsindex2 (), + T3 = strsindex3 (), + T4 = strsindex4 (), + T5 = strsindex5 (), + T6 = strsindex6 (), + T7 = strsindex7 (), + T8 = strsindex8 (), + T9 = strsindex9 () + } + fun strsindexs () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "") (Some 0) "strsindex 1"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "abΓ Γ§") (Some 0) "strsindex 2"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "abΓ c") None "strsindex 3"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "bΓ Γ§") (Some 1) "strsindex 4"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "bΓ c") None "strsindex 5"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "Γ Γ§") (Some 2) "strsindex 6"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "Γ c") None "strsindex 7"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "Γ§") (Some 3) "strsindex 8"} - {test_fn_both_sides (fn _ => strsindex "abΓ Γ§" "c") None "strsindex 9"} + <body onload={r <- rpc (strsindexsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strsindex1 t'.T1 (Some 0) "strsindex 1"} + {test_fn_both_sides2 strsindex2 t'.T2 (Some 0) "strsindex 2"} + {test_fn_both_sides2 strsindex3 t'.T3 None "strsindex 3"} + {test_fn_both_sides2 strsindex4 t'.T4 (Some 1) "strsindex 4"} + {test_fn_both_sides2 strsindex5 t'.T5 None "strsindex 5"} + {test_fn_both_sides2 strsindex6 t'.T6 (Some 2) "strsindex 6"} + {test_fn_both_sides2 strsindex7 t'.T7 None "strsindex 7"} + {test_fn_both_sides2 strsindex8 t'.T8 (Some 3) "strsindex 8"} + {test_fn_both_sides2 strsindex9 t'.T9 None "strsindex 9"} + </xml> + } /> + </body> - </xml> + </xml> + +(*strcspns*) +fun strcspn1 _ = strcspn "abΓ Γ§" "" +fun strcspn2 _ = strcspn "abΓ Γ§" "abΓ Γ§" +fun strcspn3 _ = strcspn "abΓ Γ§" "a" +fun strcspn4 _ = strcspn "abΓ Γ§" "bΓ " +fun strcspn5 _ = strcspn "abΓ Γ§" "Γ Γ§" +fun strcspn6 _ = strcspn "abΓ Γ§" "Γ§" +fun strcspnsserver _ = + return { + T1 = strcspn1 (), + T2 = strcspn2 (), + T3 = strcspn3 (), + T4 = strcspn4 (), + T5 = strcspn5 (), + T6 = strcspn6 () + } + fun strcspns () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => strcspn "abΓ Γ§" "") 4 "strcspn 1"} - {test_fn_both_sides (fn _ => strcspn "abΓ Γ§" "abΓ Γ§") 0 "strcspn 2"} - {test_fn_both_sides (fn _ => strcspn "abΓ Γ§" "a") 0 "strcspn 3"} - {test_fn_both_sides (fn _ => strcspn "abΓ Γ§" "bΓ Γ§") 1 "strcspn 4"} - {test_fn_both_sides (fn _ => strcspn "abΓ Γ§" "Γ Γ§") 2 "strcspn 5"} - {test_fn_both_sides (fn _ => strcspn "abΓ Γ§" "Γ§") 3 "strcspn 6"} + <body onload={r <- rpc (strcspnsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 strcspn1 t'.T1 4 "strcspn 1"} + {test_fn_both_sides2 strcspn2 t'.T2 0 "strcspn 2"} + {test_fn_both_sides2 strcspn3 t'.T3 0 "strcspn 3"} + {test_fn_both_sides2 strcspn4 t'.T4 1 "strcspn 4"} + {test_fn_both_sides2 strcspn5 t'.T5 2 "strcspn 5"} + {test_fn_both_sides2 strcspn6 t'.T6 3 "strcspn 6"} + </xml> + } /> + </body> - </xml> + </xml> -fun str1s () : transaction page = return <xml> - <body> - {test_fn_both_sides (fn _ => str1 #"a") "a" "str1 1"} - {test_fn_both_sides (fn _ => str1 (strsub "Γ " 0)) "Γ " "str1 2"} - {test_fn_both_sides (fn _ => str1 (strsub "aΓ‘" 1)) "Γ‘" "str1 3"} - </body> - </xml> - -fun isalnums () : transaction page = return <xml> - <body> - {test_fn_both_sides (fn _ => isalnum #"a") True "isalnum 1"} - {test_fn_both_sides (fn _ => isalnum #"a") True "isalnum 2"} - {test_fn_both_sides (fn _ => isalnum (strsub "Γ " 0)) True "isalnum 3"} - {test_fn_both_sides (fn _ => isalnum #"A") True "isalnum 4"} - {test_fn_both_sides (fn _ => isalnum (strsub "Γ" 0)) True "isalnum 5"} - {test_fn_both_sides (fn _ => isalnum #"1") True "isalnum 6"} - {test_fn_both_sides (fn _ => not (isalnum #"!")) True "isalnum 7"} - {test_fn_both_sides (fn _ => not (isalnum #"#")) True "isalnum 8"} - {test_fn_both_sides (fn _ => not (isalnum #" ")) True "isalnum 9"} - </body> -</xml> +(* str1 *) +fun str11 _ = str1 #"a" +fun str12 _ = str1 (strsub "Γ " 0) +fun str13 _ = str1 (strsub "aΓ‘" 1) -fun isalphas () : transaction page = return <xml> - <body> - {test_fn_both_sides (fn _ => isalpha #"a") True "isalpha 1"} - {test_fn_both_sides (fn _ => isalpha (strsub "Γ " 0)) True "isalpha 2"} - {test_fn_both_sides (fn _ => isalpha #"A") True "isalpha 3"} - {test_fn_both_sides (fn _ => isalpha (strsub "Γ" 0)) True "isalpha 4"} - {test_fn_both_sides (fn _ => not (isalpha #"1")) True "isalpha 5"} - {test_fn_both_sides (fn _ => not (isalpha #"!")) True "isalpha 6"} - {test_fn_both_sides (fn _ => not (isalpha #"#")) True "isalpha 7"} - {test_fn_both_sides (fn _ => not (isalpha #" ")) True "isalpha 8"} - </body> +fun str1server _ = + return { + T1 = str11 (), + T2 = str12 (), + T3 = str13 () + } + +fun str1s () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (str1server ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 str11 t'.T1 "a" "str1 1"} + {test_fn_both_sides2 str12 t'.T2 "Γ " "str1 2"} + {test_fn_both_sides2 str13 t'.T3 "Γ‘" "str1 3"} + </xml> + } /> + + </body> + </xml> + +(* isalnum *) + +fun isalnum1 _ = isalnum #"a" +fun isalnum2 _ = isalnum #"a" +fun isalnum3 _ = isalnum (strsub "Γ " 0) +fun isalnum4 _ = isalnum #"A" +fun isalnum5 _ = isalnum (strsub "Γ" 0) +fun isalnum6 _ = isalnum #"1" +fun isalnum7 _ = not (isalnum #"!") +fun isalnum8 _ = not (isalnum #"#") +fun isalnum9 _ = not (isalnum #" ") + +fun isalnumsserver _ = return { + T1 = isalnum1 (), + T2 = isalnum2 (), + T3 = isalnum3 (), + T4 = isalnum4 (), + T5 = isalnum5 (), + T6 = isalnum6 (), + T7 = isalnum7 (), + T8 = isalnum8 (), + T9 = isalnum9 () + } + +fun isalnums () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isalnumsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isalnum1 t'.T1 True "isalnum 1"} + {test_fn_both_sides2 isalnum2 t'.T2 True "isalnum 2"} + {test_fn_both_sides2 isalnum3 t'.T3 True "isalnum 3"} + {test_fn_both_sides2 isalnum4 t'.T4 True "isalnum 4"} + {test_fn_both_sides2 isalnum5 t'.T5 True "isalnum 5"} + {test_fn_both_sides2 isalnum6 t'.T6 True "isalnum 6"} + {test_fn_both_sides2 isalnum7 t'.T7 True "isalnum 7"} + {test_fn_both_sides2 isalnum8 t'.T8 True "isalnum 8"} + {test_fn_both_sides2 isalnum9 t'.T9 True "isalnum 9"} + </xml> + } /> + + </body> + </xml> + +(* isalpha *) +fun isalpha1 _ = isalpha #"a" +fun isalpha2 _ = isalpha (strsub "Γ " 0) +fun isalpha3 _ = isalpha #"A" +fun isalpha4 _ = isalpha (strsub "Γ" 0) +fun isalpha5 _ = not (isalpha #"1") +fun isalpha6 _ = not (isalpha #"!") +fun isalpha7 _ = not (isalpha #"#") +fun isalpha8 _ = not (isalpha #" ") + +fun isalphasserver () = + return { + T1 = isalpha1 (), + T2 = isalpha2 (), + T3 = isalpha3 (), + T4 = isalpha4 (), + T5 = isalpha5 (), + T6 = isalpha6 (), + T7 = isalpha7 (), + T8 = isalpha8 () + } + +fun isalphas () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (isalphasserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isalpha1 t'.T1 True "isalpha 1"} + {test_fn_both_sides2 isalpha2 t'.T2 True "isalpha 2"} + {test_fn_both_sides2 isalpha3 t'.T3 True "isalpha 3"} + {test_fn_both_sides2 isalpha4 t'.T4 True "isalpha 4"} + {test_fn_both_sides2 isalpha5 t'.T5 True "isalpha 5"} + {test_fn_both_sides2 isalpha6 t'.T6 True "isalpha 6"} + {test_fn_both_sides2 isalpha7 t'.T7 True "isalpha 7"} + {test_fn_both_sides2 isalpha8 t'.T8 True "isalpha 8"} + </xml> + } /> + + </body> </xml> -fun isblanks () : transaction page = +(* isblanks *) +fun isblank1 _ = not (isblank #"a") +fun isblank2 _ = not (isblank (strsub "Γ " 0)) +fun isblank3 _ = not (isblank #"A") +fun isblank4 _ = not (isblank (strsub "Γ" 0)) +fun isblank5 _ = not (isblank #"1") +fun isblank6 _ = not (isblank #"!") +fun isblank7 _ = not (isblank #"#") +fun isblank8 _ = isblank #" " +fun isblank9 _ = isblank #"\t" +fun isblank10 _ = not (isblank #"\n") + +fun isblanksserver _ = + return { + T1 = isblank1 (), + T2 = isblank2 (), + T3 = isblank3 (), + T4 = isblank4 (), + T5 = isblank5 (), + T6 = isblank6 (), + T7 = isblank7 (), + T8 = isblank8 (), + T9 = isblank9 (), + T10 = isblank10 () + } + +fun isblanks () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => not (isblank #"a")) True "isblank 1"} - {test_fn_both_sides (fn _ => not (isblank (strsub "Γ " 0))) True "isblank 2"} - {test_fn_both_sides (fn _ => not (isblank #"A")) True "isblank 3"} - {test_fn_both_sides (fn _ => not (isblank (strsub "Γ" 0))) True "isblank 4"} - {test_fn_both_sides (fn _ => not (isblank #"1")) True "isblank 5"} - {test_fn_both_sides (fn _ => not (isblank #"!")) True "isblank 6"} - {test_fn_both_sides (fn _ => not (isblank #"#")) True "isblank 7"} - {test_fn_both_sides (fn _ => isblank #" ") True "isblank 8"} - {test_fn_both_sides (fn _ => isblank #"\t") True "isblank 9"} - {test_fn_both_sides (fn _ => not (isblank #"\n")) True "isblank 10"} + <body onload={r <- rpc (isblanksserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isblank1 t'.T1 True "isblank 1"} + {test_fn_both_sides2 isblank2 t'.T2 True "isblank 2"} + {test_fn_both_sides2 isblank3 t'.T3 True "isblank 3"} + {test_fn_both_sides2 isblank4 t'.T4 True "isblank 4"} + {test_fn_both_sides2 isblank5 t'.T5 True "isblank 5"} + {test_fn_both_sides2 isblank6 t'.T6 True "isblank 6"} + {test_fn_both_sides2 isblank7 t'.T7 True "isblank 7"} + {test_fn_both_sides2 isblank8 t'.T8 True "isblank 8"} + {test_fn_both_sides2 isblank9 t'.T9 True "isblank 9"} + {test_fn_both_sides2 isblank10 t'.T10 True "isblank 10"} + </xml> + } /> + </body> - </xml> + </xml> + +(* iscntrls *) +fun iscntrl1 _ = not (iscntrl #"a") +fun iscntrl2 _ = not (iscntrl (strsub "Γ " 0)) +fun iscntrl3 _ = not (iscntrl #"A") +fun iscntrl4 _ = not (iscntrl (strsub "Γ" 0)) +fun iscntrl5 _ = not (iscntrl #"1") +fun iscntrl6 _ = not (iscntrl #"!") +fun iscntrl7 _ = not (iscntrl #"#") +fun iscntrl8 _ = not (iscntrl #" ") +fun iscntrl9 _ = iscntrl #"\t" +fun iscntrl10 _ = iscntrl #"\n" fun iscntrls () : transaction page = return <xml> <body> - {test_fn_sside (fn _ => not (iscntrl #"a")) True "iscntrl 1"} - {test_fn_sside (fn _ => not (iscntrl (strsub "Γ " 0))) True "iscntrl 2"} - {test_fn_sside (fn _ => not (iscntrl #"A")) True "iscntrl 3"} - {test_fn_sside (fn _ => not (iscntrl (strsub "Γ" 0))) True "iscntrl 4"} - {test_fn_sside (fn _ => not (iscntrl #"1")) True "iscntrl 5"} - {test_fn_sside (fn _ => not (iscntrl #"!")) True "iscntrl 6"} - {test_fn_sside (fn _ => not (iscntrl #"#")) True "iscntrl 7"} - {test_fn_sside (fn _ => not (iscntrl #" ")) True "iscntrl 8"} - {test_fn_sside (fn _ => iscntrl #"\t") True "iscntrl 9"} - {test_fn_sside (fn _ => iscntrl #"\n") True "iscntrl 10"} + {test_fn_sside iscntrl1 True "iscntrl 1"} + {test_fn_sside iscntrl2 True "iscntrl 2"} + {test_fn_sside iscntrl3 True "iscntrl 3"} + {test_fn_sside iscntrl4 True "iscntrl 4"} + {test_fn_sside iscntrl5 True "iscntrl 5"} + {test_fn_sside iscntrl6 True "iscntrl 6"} + {test_fn_sside iscntrl7 True "iscntrl 7"} + {test_fn_sside iscntrl8 True "iscntrl 8"} + {test_fn_sside iscntrl9 True "iscntrl 9"} + {test_fn_sside iscntrl10 True "iscntrl 10"} </body> - </xml> + </xml> + +(* isdigits *) +fun isdigit1 _ = not (isdigit #"a") +fun isdigit2 _ = not (isdigit (strsub "Γ " 0)) +fun isdigit3 _ = not (isdigit #"A") +fun isdigit4 _ = not (isdigit (strsub "Γ" 0)) +fun isdigit5 _ = isdigit #"1" +fun isdigit6 _ = not (isdigit #"!") +fun isdigit7 _ = not (isdigit #"#") +fun isdigit8 _ = not (isdigit #" ") +fun isdigit9 _ = not (isdigit #"\t") +fun isdigit10 _ = not (isdigit #"\n") +fun isdigitsserver _ = + return { + T1 = isdigit1 (), + T2 = isdigit2 (), + T3 = isdigit3 (), + T4 = isdigit4 (), + T5 = isdigit5 (), + T6 = isdigit6 (), + T7 = isdigit7 (), + T8 = isdigit8 (), + T9 = isdigit9 (), + T10 = isdigit10 () + } + fun isdigits () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => not (isdigit #"a")) True "isdigit 1"} - {test_fn_both_sides (fn _ => not (isdigit (strsub "Γ " 0))) True "isdigit 2"} - {test_fn_both_sides (fn _ => not (isdigit #"A")) True "isdigit 3"} - {test_fn_both_sides (fn _ => not (isdigit (strsub "Γ" 0))) True "isdigit 4"} - {test_fn_both_sides (fn _ => isdigit #"1") True "isdigit 5"} - {test_fn_both_sides (fn _ => not (isdigit #"!")) True "isdigit 6"} - {test_fn_both_sides (fn _ => not (isdigit #"#")) True "isdigit 7"} - {test_fn_both_sides (fn _ => not (isdigit #" ")) True "isdigit 8"} - {test_fn_both_sides (fn _ => not (isdigit #"\t")) True "isdigit 9"} - {test_fn_both_sides (fn _ => not (isdigit #"\n")) True "isdigit 10"} - </body> - </xml> + <body onload={r <- rpc (isdigitsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isdigit1 t'.T1 True "isdigit 1"} + {test_fn_both_sides2 isdigit2 t'.T2 True "isdigit 2"} + {test_fn_both_sides2 isdigit3 t'.T3 True "isdigit 3"} + {test_fn_both_sides2 isdigit4 t'.T4 True "isdigit 4"} + {test_fn_both_sides2 isdigit5 t'.T5 True "isdigit 5"} + {test_fn_both_sides2 isdigit6 t'.T6 True "isdigit 6"} + {test_fn_both_sides2 isdigit7 t'.T7 True "isdigit 7"} + {test_fn_both_sides2 isdigit8 t'.T8 True "isdigit 8"} + {test_fn_both_sides2 isdigit9 t'.T9 True "isdigit 9"} + {test_fn_both_sides2 isdigit10 t'.T10 True "isdigit 10"} + </xml> + } /> + + + </body> + </xml> fun isgraphs () : transaction page = return <xml> @@ -374,169 +954,498 @@ fun isgraphs () : transaction page = </body> </xml> +(* islowers *) +fun islower1 _ = islower #"a" +fun islower2 _ = islower (strsub "Γ " 0) +fun islower3 _ = not (islower #"A") +fun islower4 _ = not (islower (strsub "Γ" 0)) +fun islower5 _ = not (islower #"1") +fun islower6 _ = not (islower #"!") +fun islower7 _ = not (islower #"#") +fun islower8 _ = not (islower #" ") +fun islower9 _ = not (islower #"\t") +fun islower10 _ = not (islower #"\n") + +fun islowersserver _ = + return { + T1 = islower1 (), + T2 = islower2 (), + T3 = islower3 (), + T4 = islower4 (), + T5 = islower5 (), + T6 = islower6 (), + T7 = islower7 (), + T8 = islower8 (), + T9 = islower9 (), + T10 = islower10 () + } + fun islowers () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => islower #"a") True "islower 1"} - {test_fn_both_sides (fn _ => islower (strsub "Γ " 0)) True "islower 2"} - {test_fn_both_sides (fn _ => not (islower #"A")) True "islower 3"} - {test_fn_both_sides (fn _ => not (islower (strsub "Γ" 0))) True "islower 4"} - {test_fn_both_sides (fn _ => not (islower #"1")) True "islower 5"} - {test_fn_both_sides (fn _ => not (islower #"!")) True "islower 6"} - {test_fn_both_sides (fn _ => not (islower #"#")) True "islower 7"} - {test_fn_both_sides (fn _ => not (islower #" ")) True "islower 8"} - {test_fn_both_sides (fn _ => not (islower #"\t")) True "islower 9"} - {test_fn_both_sides (fn _ => not (islower #"\n")) True "islower 10"} + <body onload={r <- rpc (islowersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 islower1 t'.T1 True "islower 1"} + {test_fn_both_sides2 islower2 t'.T2 True "islower 2"} + {test_fn_both_sides2 islower3 t'.T3 True "islower 3"} + {test_fn_both_sides2 islower4 t'.T4 True "islower 4"} + {test_fn_both_sides2 islower5 t'.T5 True "islower 5"} + {test_fn_both_sides2 islower6 t'.T6 True "islower 6"} + {test_fn_both_sides2 islower7 t'.T7 True "islower 7"} + {test_fn_both_sides2 islower8 t'.T8 True "islower 8"} + {test_fn_both_sides2 islower9 t'.T9 True "islower 9"} + {test_fn_both_sides2 islower10 t'.T10 True "islower 10"} + </xml> + } /> </body> - </xml> + </xml> + +(* isprint *) +fun isprint1 _ = isprint #"a" +fun isprint2 _ = isprint (strsub "Γ " 0) +fun isprint3 _ = isprint #"A" +fun isprint4 _ = isprint (strsub "Γ" 0) +fun isprint5 _ = isprint #"1" +fun isprint6 _ = isprint #"!" +fun isprint7 _ = isprint #"#" +fun isprint8 _ = isprint #" " +fun isprint9 _ = not (isprint #"\t") +fun isprint10 _ = not (isprint #"\n") +fun isprintsserver _ = return { + T1 = isprint1 (), + T2 = isprint2 (), + T3 = isprint3 (), + T4 = isprint4 (), + T5 = isprint5 (), + T6 = isprint6 (), + T7 = isprint7 (), + T8 = isprint8 (), + T9 = isprint9 (), + T10 = isprint10 () + } + fun isprints () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => isprint #"a") True "isprint 1"} - {test_fn_both_sides (fn _ => isprint (strsub "Γ " 0)) True "isprint 2"} - {test_fn_both_sides (fn _ => isprint #"A") True "isprint 3"} - {test_fn_both_sides (fn _ => isprint (strsub "Γ" 0)) True "isprint 4"} - {test_fn_both_sides (fn _ => isprint #"1") True "isprint 5"} - {test_fn_both_sides (fn _ => isprint #"!") True "isprint 6"} - {test_fn_both_sides (fn _ => isprint #"#") True "isprint 7"} - {test_fn_both_sides (fn _ => isprint #" ") True "isprint 8"} - {test_fn_both_sides (fn _ => not (isprint #"\t")) True "isprint 9"} - {test_fn_both_sides (fn _ => not (isprint #"\n")) True "isprint 10"} - </body> - </xml> + <body onload={r <- rpc (isprintsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isprint1 t'.T1 True "isprint 1"} + {test_fn_both_sides2 isprint2 t'.T2 True "isprint 2"} + {test_fn_both_sides2 isprint3 t'.T3 True "isprint 3"} + {test_fn_both_sides2 isprint4 t'.T4 True "isprint 4"} + {test_fn_both_sides2 isprint5 t'.T5 True "isprint 5"} + {test_fn_both_sides2 isprint6 t'.T6 True "isprint 6"} + {test_fn_both_sides2 isprint7 t'.T7 True "isprint 7"} + {test_fn_both_sides2 isprint8 t'.T8 True "isprint 8"} + {test_fn_both_sides2 isprint9 t'.T9 True "isprint 9"} + {test_fn_both_sides2 isprint10 t'.T10 True "isprint 10"} + </xml> + } /> + </body> + </xml> +(* ispunct *) +fun ispunct1 _ = not (ispunct #"a") +fun ispunct2 _ = not (ispunct (strsub "Γ " 0)) +fun ispunct3 _ = not (ispunct #"A") +fun ispunct4 _ = not (ispunct (strsub "Γ" 0)) +fun ispunct5 _ = not (ispunct #"1") +fun ispunct6 _ = ispunct #"!" +fun ispunct7 _ = ispunct #"#" +fun ispunct8 _ = not (ispunct #" ") +fun ispunct9 _ = not (ispunct #"\t") +fun ispunct10 _ = not (ispunct #"\n") + fun ispuncts () : transaction page = return <xml> - <body> - {test_fn_sside (fn _ => not (ispunct #"a")) True "ispunct 1"} - {test_fn_sside (fn _ => not (ispunct (strsub "Γ " 0))) True "ispunct 2"} - {test_fn_sside (fn _ => not (ispunct #"A")) True "ispunct 3"} - {test_fn_sside (fn _ => not (ispunct (strsub "Γ" 0))) True "ispunct 4"} - {test_fn_sside (fn _ => not (ispunct #"1")) True "ispunct 5"} - {test_fn_sside (fn _ => ispunct #"!") True "ispunct 6"} - {test_fn_sside (fn _ => ispunct #"#") True "ispunct 7"} - {test_fn_sside (fn _ => not (ispunct #" ")) True "ispunct 8"} - {test_fn_sside (fn _ => not (isprint #"\t")) True "ispunct 9"} - {test_fn_sside (fn _ => not (isprint #"\n")) True "ispunct 10"} + <body> + {test_fn_sside ispunct1 True "ispunct 1"} + {test_fn_sside ispunct2 True "ispunct 2"} + {test_fn_sside ispunct3 True "ispunct 3"} + {test_fn_sside ispunct4 True "ispunct 4"} + {test_fn_sside ispunct5 True "ispunct 5"} + {test_fn_sside ispunct6 True "ispunct 6"} + {test_fn_sside ispunct7 True "ispunct 7"} + {test_fn_sside ispunct8 True "ispunct 8"} + {test_fn_sside ispunct9 True "ispunct 9"} + {test_fn_sside ispunct10 True "ispunct 10"} </body> - </xml> + </xml> + +(* isspace *) +fun isspace1 _ = not (isspace #"a") +fun isspace2 _ = not (isspace (strsub "Γ " 0)) +fun isspace3 _ = not (isspace #"A") +fun isspace4 _ = not (isspace (strsub "Γ" 0)) +fun isspace5 _ = not (isspace #"1") +fun isspace6 _ = not (isspace #"!") +fun isspace7 _ = not (isspace #"#") +fun isspace8 _ = isspace #" " +fun isspace9 _ = isspace #"\t" +fun isspace10 _ = isspace #"\n" +fun isspacesserver _ = + return { + T1 = isspace1 (), + T2 = isspace2 (), + T3 = isspace3 (), + T4 = isspace4 (), + T5 = isspace5 (), + T6 = isspace6 (), + T7 = isspace7 (), + T8 = isspace8 (), + T9 = isspace9 (), + T10 = isspace10 () + } + fun isspaces () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => not (isspace #"a")) True "isspace 1"} - {test_fn_both_sides (fn _ => not (isspace (strsub "Γ " 0))) True "isspace 2"} - {test_fn_both_sides (fn _ => not (isspace #"A")) True "isspace 3"} - {test_fn_both_sides (fn _ => not (isspace (strsub "Γ" 0))) True "isspace 4"} - {test_fn_both_sides (fn _ => not (isspace #"1")) True "isspace 5"} - {test_fn_both_sides (fn _ => not (isspace #"!")) True "isspace 6"} - {test_fn_both_sides (fn _ => not (isspace #"#")) True "isspace 7"} - {test_fn_both_sides (fn _ => isspace #" ") True "isspace 8"} - {test_fn_both_sides (fn _ => isspace #"\t") True "isspace 9"} - {test_fn_both_sides (fn _ => isspace #"\n") True "isspace 10"} + <body onload={r <- rpc (isspacesserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isspace1 t'.T1 True "isspace 1"} + {test_fn_both_sides2 isspace2 t'.T2 True "isspace 2"} + {test_fn_both_sides2 isspace3 t'.T3 True "isspace 3"} + {test_fn_both_sides2 isspace4 t'.T4 True "isspace 4"} + {test_fn_both_sides2 isspace5 t'.T5 True "isspace 5"} + {test_fn_both_sides2 isspace6 t'.T6 True "isspace 6"} + {test_fn_both_sides2 isspace7 t'.T7 True "isspace 7"} + {test_fn_both_sides2 isspace8 t'.T8 True "isspace 8"} + {test_fn_both_sides2 isspace9 t'.T9 True "isspace 9"} + {test_fn_both_sides2 isspace10 t'.T10 True "isspace 10"} + </xml> + } /> + </body> - </xml> - + </xml> + +(* isupper *) +fun isupper1 _ = not (isupper #"a") +fun isupper2 _ = not (isupper (strsub "Γ " 0)) +fun isupper3 _ = isupper #"A" +fun isupper4 _ = isupper (strsub "Γ" 0) +fun isupper5 _ = not (isupper #"1") +fun isupper6 _ = not (isupper #"!") +fun isupper7 _ = not (isupper #"#") +fun isupper8 _ = not (isupper #" ") +fun isupper9 _ = not (isupper #"\t") +fun isupper10 _ = not (isupper #"\n") + +fun isuppersserver _ = + return { + T1 = isupper1 (), + T2 = isupper2 (), + T3 = isupper3 (), + T4 = isupper4 (), + T5 = isupper5 (), + T6 = isupper6 (), + T7 = isupper7 (), + T8 = isupper8 (), + T9 = isupper9 (), + T10 = isupper10 () + } + fun isuppers () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => not (isupper #"a")) True "isupper 1"} - {test_fn_both_sides (fn _ => not (isupper (strsub "Γ " 0))) True "isupper 2"} - {test_fn_both_sides (fn _ => isupper #"A") True "isupper 3"} - {test_fn_both_sides (fn _ => isupper (strsub "Γ" 0)) True "isupper 4"} - {test_fn_both_sides (fn _ => not (isupper #"1")) True "isupper 5"} - {test_fn_both_sides (fn _ => not (isupper #"!")) True "isupper 6"} - {test_fn_both_sides (fn _ => not (isupper #"#")) True "isupper 7"} - {test_fn_both_sides (fn _ => not (isupper #" ")) True "isupper 8"} - {test_fn_both_sides (fn _ => not (isupper #"\t")) True "isupper 9"} - {test_fn_both_sides (fn _ => not (isupper #"\n")) True "isupper 10"} - </body> - </xml> + <body onload={r <- rpc (isuppersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isupper1 t'.T1 True "isupper 1"} + {test_fn_both_sides2 isupper2 t'.T2 True "isupper 2"} + {test_fn_both_sides2 isupper3 t'.T3 True "isupper 3"} + {test_fn_both_sides2 isupper4 t'.T4 True "isupper 4"} + {test_fn_both_sides2 isupper5 t'.T5 True "isupper 5"} + {test_fn_both_sides2 isupper6 t'.T6 True "isupper 6"} + {test_fn_both_sides2 isupper7 t'.T7 True "isupper 7"} + {test_fn_both_sides2 isupper8 t'.T8 True "isupper 8"} + {test_fn_both_sides2 isupper9 t'.T9 True "isupper 9"} + {test_fn_both_sides2 isupper10 t'.T10 True "isupper 10"} + </xml> + } /> + </body> + </xml> + +(* isxdigit *) +fun isxdigit1 _ = isxdigit #"a" +fun isxdigit2 _ = not (isxdigit (strsub "Γ " 0)) +fun isxdigit3 _ = isxdigit #"A" +fun isxdigit4 _ = not (isxdigit (strsub "Γ" 0)) +fun isxdigit5 _ = isxdigit #"1" +fun isxdigit6 _ = not (isxdigit #"!") +fun isxdigit7 _ = not (isxdigit #"#") +fun isxdigit8 _ = not (isxdigit #" ") +fun isxdigit9 _ = not (isxdigit #"\t") +fun isxdigit10 _ = not (isxdigit #"\n") + +fun isxdigitsserver _ = + return { + T1 = isxdigit1 (), + T2 = isxdigit2 (), + T3 = isxdigit3 (), + T4 = isxdigit4 (), + T5 = isxdigit5 (), + T6 = isxdigit6 (), + T7 = isxdigit7 (), + T8 = isxdigit8 (), + T9 = isxdigit9 (), + T10 = isxdigit10 () + } + fun isxdigits () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => isxdigit #"a") True "isxdigit 1"} - {test_fn_both_sides (fn _ => not (isxdigit (strsub "Γ " 0))) True "isxdigit 2"} - {test_fn_both_sides (fn _ => isxdigit #"A") True "isxdigit 3"} - {test_fn_both_sides (fn _ => not (isxdigit (strsub "Γ" 0))) True "isxdigit 4"} - {test_fn_both_sides (fn _ => isxdigit #"1") True "isxdigit 5"} - {test_fn_both_sides (fn _ => not (isxdigit #"!")) True "isxdigit 6"} - {test_fn_both_sides (fn _ => not (isxdigit #"#")) True "isxdigit 7"} - {test_fn_both_sides (fn _ => not (isxdigit #" ")) True "isxdigit 8"} - {test_fn_both_sides (fn _ => not (isxdigit #"\t")) True "isxdigit 9"} - {test_fn_both_sides (fn _ => not (isxdigit #"\n")) True "isxdigit 10"} + <body onload={r <- rpc (isxdigitsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 isxdigit1 t'.T1 True "isxdigit 1"} + {test_fn_both_sides2 isxdigit2 t'.T2 True "isxdigit 2"} + {test_fn_both_sides2 isxdigit3 t'.T3 True "isxdigit 3"} + {test_fn_both_sides2 isxdigit4 t'.T4 True "isxdigit 4"} + {test_fn_both_sides2 isxdigit5 t'.T5 True "isxdigit 5"} + {test_fn_both_sides2 isxdigit6 t'.T6 True "isxdigit 6"} + {test_fn_both_sides2 isxdigit7 t'.T7 True "isxdigit 7"} + {test_fn_both_sides2 isxdigit8 t'.T8 True "isxdigit 8"} + {test_fn_both_sides2 isxdigit9 t'.T9 True "isxdigit 9"} + {test_fn_both_sides2 isxdigit10 t'.T10 True "isxdigit 10"} + </xml> + } /> + </body> - </xml> + </xml> + +(* tolower *) + +fun tolower1 _ = tolower #"A" +fun tolower2 _ = tolower #"a" +fun tolower3 _ = tolower (strsub "Γ‘" 0) +fun tolower4 _ = tolower (strsub "Γ" 0) +fun tolower5 _ = tolower #"1" +fun tolower6 _ = tolower (strsub "Γ" 0) + +fun tolowersserver _ = + return { + T1 = tolower1 (), + T2 = tolower2 (), + T3 = tolower3 (), + T4 = tolower4 (), + T5 = tolower5 (), + T6 = tolower6 () + } fun tolowers () : transaction page = - let - fun lower_of a _ = - tolower a - in - return <xml> - <body> - {test_fn_both_sides (lower_of #"A") #"a" "tolower 1"} - {test_fn_both_sides (lower_of #"a") #"a" "tolower 2"} - {test_fn_both_sides (lower_of (strsub "Γ‘" 0)) (strsub "Γ‘" 0) "tolower 3"} - {test_fn_both_sides (lower_of (strsub "Γ" 0)) (strsub "Γ‘" 0) "tolower 4"} - {test_fn_both_sides (lower_of #"1") #"1" "tolower 5"} - {test_fn_cside (lower_of (strsub "Γ" 0)) (lower_of (strsub "Γ" 0) ()) "tolower 6"} - </body> + t <- source None; + return <xml> + <body onload={r <- rpc (tolowersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 tolower1 t'.T1 #"a" "tolower 1"} + {test_fn_both_sides2 tolower2 t'.T2 #"a" "tolower 2"} + {test_fn_both_sides2 tolower3 t'.T3 (strsub "Γ‘" 0) "tolower 3"} + {test_fn_both_sides2 tolower4 t'.T4 (strsub "Γ‘" 0) "tolower 4"} + {test_fn_both_sides2 tolower5 t'.T5 #"1" "tolower 5"} + {test_fn_both_sides2 tolower6 t'.T6 (strsub "Γ" 0) "tolower 6"} + + </xml> + } /> + + </body> </xml> - end - + +(* toupper *) +fun toupper1 _ = toupper #"A" +fun toupper2 _ = toupper #"a" +fun toupper3 _ = toupper (strsub "Γ‘" 0) +fun toupper4 _ = toupper (strsub "Γ" 0) +fun toupper5 _ = toupper #"1" +fun toupper6 _ = toupper (strsub "Γ" 0) + +fun touppersserver _ = + return { + T1 = toupper1 (), + T2 = toupper2 (), + T3 = toupper3 (), + T4 = toupper4 (), + T5 = toupper5 (), + T6 = toupper6 () + } + fun touppers () : transaction page = - let - fun upper_of a _ = - toupper a - in - return <xml> - <body> - {test_fn_both_sides (upper_of #"A") #"A" "toupper 1"} - {test_fn_both_sides (upper_of #"a") #"A" "toupper 2"} - {test_fn_both_sides (upper_of (strsub "Γ‘" 0)) (strsub "Γ" 0) "toupper 3"} - {test_fn_both_sides (upper_of (strsub "Γ" 0)) (strsub "Γ" 0) "toupper 4"} - {test_fn_both_sides (upper_of #"1") #"1" "toupper 5"} - - {test_fn_cside (upper_of (strsub "Γ" 0)) (upper_of (strsub "Γ" 0) ()) "toupper 6"} - </body> + t <- source None; + return <xml> + <body onload={r <- rpc (touppersserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_both_sides2 toupper1 t'.T1 #"A" "toupper 1"} + {test_fn_both_sides2 toupper2 t'.T2 #"A" "toupper 2"} + {test_fn_both_sides2 toupper3 t'.T3 (strsub "Γ" 0) "toupper 3"} + {test_fn_both_sides2 toupper4 t'.T4 (strsub "Γ" 0) "toupper 4"} + {test_fn_both_sides2 toupper5 t'.T5 #"1" "toupper 5"} + {test_fn_both_sides2 toupper6 t'.T6 (strsub "Γ" 0) "toupper 6"} + + </xml> + } /> + + </body> </xml> - end +(* ord and chr*) +fun ordchr1 _ = chr (ord #"A") +fun ordchr2 _ = chr (ord #"a") +fun ordchr3 _ = chr (ord (strsub "Γ‘" 0)) +fun ordchr4 _ = chr (ord (strsub "Γ" 0)) +fun ordchr5 _ = chr (ord #"1") +fun ordchr6 _ = chr (ord #"\n") +fun ordchr7 _ = chr (ord (strsub "γ" 0)) +fun ordchr8 _ = chr (ord (strsub "ζΌ’" 0)) +fun ordchr9 _ = chr (ord (strsub "γ«" 0)) + +fun ordchrsserver _ = return { + T1 = ordchr1 (), + T2 = ordchr2 (), + T3 = ordchr3 (), + T4 = ordchr4 (), + T5 = ordchr5 (), + T6 = ordchr6 (), + T7 = ordchr7 (), + T8 = ordchr8 (), + T9 = ordchr9 () + } + fun ord_and_chrs () : transaction page = + t <- source None; return <xml> - <body> - {test_fn_both_sides (fn _ => chr (ord #"A")) #"A" "ord => chr 1"} - {test_fn_both_sides (fn _ => chr (ord #"a")) #"a" "ord => chr 2"} - {test_fn_both_sides (fn _ => chr (ord (strsub "Γ‘" 0))) (strsub "Γ‘" 0) "ord => chr 3"} - {test_fn_both_sides (fn _ => chr (ord (strsub "Γ" 0))) (strsub "Γ" 0) "ord => chr 4"} - {test_fn_both_sides (fn _ => chr (ord #"1")) #"1" "ord => chr 5"} - {test_fn_both_sides (fn _ => chr (ord #"\n")) #"\n" "ord => chr 6"} - {test_fn_both_sides (fn _ => chr (ord (strsub "γ" 0))) (strsub "γ" 0) "ord => chr 7"} - {test_fn_both_sides (fn _ => chr (ord (strsub "ζΌ’" 0))) (strsub "ζΌ’" 0) "ord => chr 8"} - {test_fn_both_sides (fn _ => chr (ord (strsub "γ«" 0))) (strsub "γ«" 0) "ord => chr 9"} + <body onload={r <- rpc (ordchrsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + + {test_fn_both_sides2 ordchr1 t'.T1 #"A" "ord => chr 1"} + {test_fn_both_sides2 ordchr2 t'.T2 #"a" "ord => chr 2"} + {test_fn_both_sides2 ordchr3 t'.T3 (strsub "Γ‘" 0) "ord => chr 3"} + {test_fn_both_sides2 ordchr4 t'.T4 (strsub "Γ" 0) "ord => chr 4"} + {test_fn_both_sides2 ordchr5 t'.T5 #"1" "ord => chr 5"} + {test_fn_both_sides2 ordchr6 t'.T6 #"\n" "ord => chr 6"} + {test_fn_both_sides2 ordchr7 t'.T7 (strsub "γ" 0) "ord => chr 7"} + {test_fn_both_sides2 ordchr8 t'.T8 (strsub "ζΌ’" 0) "ord => chr 8"} + {test_fn_both_sides2 ordchr9 t'.T9 (strsub "γ«" 0) "ord => chr 9"} + </xml> + } /> </body> </xml> +(* ord *) +fun ord1 _ = ord #"a" +fun ord2 _ = ord (strsub "Γ‘" 0) +fun ord3 _ = ord #"5" +fun ord4 _ = ord (strsub "γ" 0) +fun ord5 _ = ord (strsub "ζΌ’" 0) +fun ord6 _ = ord (strsub "γ«" 0) + +fun ordsserver _ = + return { + T1 = ord1 (), + T2 = ord2 (), + T3 = ord3 (), + T4 = ord4 (), + T5 = ord5 (), + T6 = ord6 () + } + fun test_ords () : transaction page = + t <- source None; + return <xml> + <body onload={r <- rpc (ordsserver ()); + set t (Some r); + return ()}> + <dyn signal={r <- signal t; case r of None => return <xml></xml> + | Some t' => return <xml> + {test_fn_cside ord1 t'.T1 "test ord 1"} + {test_fn_cside ord2 t'.T2 "test ord 2"} + {test_fn_cside ord3 t'.T3 "test ord 3"} + {test_fn_cside ord4 t'.T4 "test ord 4"} + {test_fn_cside ord5 t'.T5 "test ord 5"} + {test_fn_cside ord6 t'.T6 "test ord 6"} + </xml> + } /> + </body> + </xml> + + + +and test_post () : transaction page = let - fun ord_of c _ = - ord c + fun test_post_cb r = + return <xml> + <body> + <pre> + {[r.T1]} + </pre> + <pre> + {[r.T2]} + </pre> + <pre> + {[r.T3]} + </pre> + <pre> + {[r.T4]} + </pre> + <pre> + {[r.T5]} + </pre> + <pre> + {[r.T6]} + </pre> + <pre> + {[r.T7]} + </pre> + </body> + </xml> + in + t1 <- source ""; + t2 <- source "aco"; + t3 <- source "Ñçá"; + t4 <- source "γ"; + t5 <- source "ππππ"; + t6 <- source "Π€ΡΠ½ΠΊΡΠΈΠΎΠ½Π°Π»ΡΠ½ΠΎΠ΅"; + t7 <- source "ΩΨΈΩΩΩΨ©"; return <xml> <body> - {test_fn_cside (ord_of (strsub "a" 0)) (ord_of (strsub "a" 0) ()) "test ord 1"} - {test_fn_cside (ord_of (strsub "Γ‘" 0)) (ord_of (strsub "Γ‘" 0) ()) "test ord 2"} - {test_fn_cside (ord_of (strsub "5" 0)) (ord_of (strsub "5" 0) ()) "test ord 3"} - {test_fn_cside (ord_of (strsub "γ" 0)) (ord_of (strsub "γ" 0) ()) "test ord 4"} - {test_fn_cside (ord_of (strsub "ζΌ’" 0)) (ord_of (strsub "ζΌ’" 0) ()) "test ord 5"} - {test_fn_cside (ord_of (strsub "γ«" 0)) (ord_of (strsub "γ«" 0) ()) "test ord 6"} + <form> + <textbox{#T1} source={t1} /> + <textbox{#T2} source={t2} /> + <textbox{#T3} source={t3} /> + <textbox{#T4} source={t4} /> + <textbox{#T5} source={t5} /> + <textbox{#T6} source={t6} /> + <textbox{#T7} source={t7} /> + <submit action={test_post_cb} value="submit" /> + </form> </body> </xml> end - + table t : { Id : int, Text : string } fun test_db () : transaction page = @@ -790,5 +1699,6 @@ fun index () : transaction page = <a link={test_ords ()}>test ord</a> <a link={highencode ()}>highencode</a> <a link={test_db ()}>test_db</a> + <a link={test_post ()}>test_post</a> </body> </xml> diff --git a/tests/utf8.urp b/tests/utf8.urp index 25288aa8..74fcb1c2 100644 --- a/tests/utf8.urp +++ b/tests/utf8.urp @@ -1,6 +1,7 @@ database dbname=utf8 sql utf8.sql safeGet Utf8/test_db +serverOnly Utf8.generateTests $/option utf8
\ No newline at end of file |