You are viewing a plain text version of this content. The canonical link for it is here.
Posted to mod_dtcl-cvs@tcl.apache.org by da...@apache.org on 2001/09/02 16:04:16 UTC
cvs commit: tcl-moddtcl/tests dtcl-test.tcl dtcl.test dtcl-test.ttml
davidw 01/09/02 07:04:16
Modified: . mod_dtcl.c mod_dtcl.h parser.c tcl_commands.c
docs nav.html
tests dtcl.test
Added: tests dtcl-test.tcl
Removed: tests dtcl-test.ttml
Log:
Finalized i18n changes.
Removed the possibility of not using i18n.
Added a test case for .tcl files.
Removed extraneous test file.
Added some links in the documentation - to Tcl and Apache.
Revision Changes Path
1.47 +19 -20 tcl-moddtcl/mod_dtcl.c
Index: mod_dtcl.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.c,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -r1.46 -r1.47
--- mod_dtcl.c 2001/08/28 11:41:39 1.46
+++ mod_dtcl.c 2001/09/02 14:04:16 1.47
@@ -57,7 +57,7 @@
* originally written at the National Center for Supercomputing Applications,
* University of Illinois, Urbana-Champaign. */
-/* $Id: mod_dtcl.c,v 1.46 2001/08/28 11:41:39 davidw Exp $ */
+/* $Id: mod_dtcl.c,v 1.47 2001/09/02 14:04:16 davidw Exp $ */
/* mod_dtcl.c by David Welton <da...@apache.org> - originally mod_include. */
/* See http://tcl.apache.org/mod_dtcl/credits.ttml for additional credits. */
@@ -91,6 +91,9 @@
static int send_content(request_rec *);
static int execute_and_check(Tcl_Interp *interp, Tcl_Obj *outbuf, request_rec *r);
+/* just need some arbitrary non-NULL pointer which can't also be a request_rec */
+#define NESTED_INCLUDE_MAGIC (&dtcl_module)
+
/* Functions for Tcl Channel */
static int closeproc(ClientData, Tcl_Interp *);
@@ -117,9 +120,6 @@
NULL
};
-/* just need some arbitrary non-NULL pointer which can't also be a request_rec */
-#define NESTED_INCLUDE_MAGIC (&dtcl_module)
-
static int inputproc(ClientData instancedata, char *buf, int toRead, int *errorCodePtr)
{
return EINVAL;
@@ -130,8 +130,14 @@
static int outputproc(ClientData instancedata, char *buf, int toWrite, int *errorCodePtr)
{
+ Tcl_DString outstring;
dtcl_server_conf *dsc = (dtcl_server_conf *)instancedata;
- memwrite(dsc->obuffer, buf, toWrite);
+ /* we will have to deal with this when we switch over to using the
+ channel directly */
+ Tcl_UtfToExternalDString(NULL, buf, toWrite, &outstring);
+ memwrite(dsc->obuffer, Tcl_DStringValue(&outstring),
+ Tcl_DStringLength(&outstring));
+ Tcl_DStringFree(&outstring);
return toWrite;
}
@@ -169,6 +175,9 @@
/* Write something to the output buffer structure */
+/* In the future, we ought to replace calls to this with
+ Tcl_WriteChars or something else that uses the channel directly. */
+
int memwrite(obuff *buffer, char *input, int len)
{
if (buffer->len == 0)
@@ -268,7 +277,6 @@
char *StringToUtf(char *input, ap_pool *pool)
{
-#if DTCL_I18N == 1
char *temp;
Tcl_DString dstr;
Tcl_DStringInit(&dstr);
@@ -277,10 +285,6 @@
temp = ap_pstrdup(pool, Tcl_DStringValue(&dstr));
Tcl_DStringFree(&dstr);
return temp;
-#else
- /* If we aren't using the i18n stuff, no need to do anything */
- return input;
-#endif
}
/* Function to be used should we desire to upload files to a variable */
@@ -370,7 +374,7 @@
Tcl_SetStringObj(outbuf, "namespace eval request {\n", -1);
if (dsc->dtcl_before_script) {
Tcl_AppendObjToObj(outbuf, dsc->dtcl_before_script);
- }
+ }
Tcl_AppendToObj(outbuf, "buffer_add \"", -1);
}
else
@@ -407,11 +411,6 @@
else
Tcl_AppendToObj(outbuf, "\n", -1);
-#if DTCL_I18N == 1
- /* Convert to encoding */
- Tcl_SetStringObj(outbuf, StringToUtf(Tcl_GetString(outbuf), r->pool), -1);
-#endif
-
/* END PARSER */
return TCL_OK;
}
@@ -518,7 +517,7 @@
int errstatus;
Tcl_Interp *interp;
-
+
dtcl_interp_globals *globals = NULL;
dtcl_server_conf *dsc = NULL;
dsc = dtcl_get_conf(r);
@@ -781,7 +780,7 @@
hosts */
if (sr != s) /* not the first one */
{
- mydsc = ap_pcalloc(p, sizeof(dtcl_server_conf));
+ mydsc = ap_pcalloc(p, sizeof(dtcl_server_conf));
ap_set_module_config(sr->module_config, &dtcl_module, mydsc);
copy_dtcl_config(p, dsc, mydsc);
if (dsc->seperate_virtual_interps != 0)
@@ -896,7 +895,7 @@
dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(s->module_config, &dtcl_module);
if (!strcmp(arg, "on"))
dsc->seperate_virtual_interps = 1;
- else
+ else
dsc->seperate_virtual_interps = 0;
return NULL;
}
@@ -911,7 +910,7 @@
dsc = (dtcl_server_conf *) ap_get_module_config(r->server->module_config, &dtcl_module);
if (dconf != NULL)
{
- dtcl_server_conf *ddc = (dtcl_server_conf *)
+ dtcl_server_conf *ddc = (dtcl_server_conf *)
ap_get_module_config(dconf, &dtcl_module); /* per directory config */
newconfig = (dtcl_server_conf *) ap_pcalloc(r->pool, sizeof(dtcl_server_conf));
1.12 +0 -5 tcl-moddtcl/mod_dtcl.h
Index: mod_dtcl.h
===================================================================
RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- mod_dtcl.h 2001/08/31 14:32:41 1.11
+++ mod_dtcl.h 2001/09/02 14:04:16 1.12
@@ -24,11 +24,6 @@
troublemakers. */
#define HIDE_DTCL_VERSION 1
-/* Turn on the translation stuff. This will translate things to UTF
- correctly. Turn off *only* if you will *not* use anything but
- plain ascii */
-#define DTCL_I18N 1
-
/* Allow <+ +> tags for backwards compatibility. Use the
mod_dtcl/contrib/newtags.sh script to update your .ttml files to
use <? ?> tags. */
1.3 +8 -8 tcl-moddtcl/parser.c
Index: parser.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/parser.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- parser.c 2001/08/31 14:32:41 1.2
+++ parser.c 2001/09/02 14:04:16 1.3
@@ -1,4 +1,4 @@
-/* $Id: parser.c,v 1.2 2001/08/31 14:32:41 davidw Exp $
+/* $Id: parser.c,v 1.3 2001/09/02 14:04:16 davidw Exp $
Dtcl parser - doesn't really need any of the includes besides
tcl.h.
@@ -25,7 +25,7 @@
int endseqlen = strlen(ENDING_SEQUENCE), startseqlen = strlen(STARTING_SEQUENCE), p = 0;
int inside = 0;
Tcl_DString dstr;
-/* Tcl_DString convdstr; */
+ Tcl_DString convdstr;
Tcl_DStringInit(&dstr);
@@ -132,14 +132,14 @@
}
}
-/* Tcl_ExternalToUtfDString(NULL,
+ Tcl_ExternalToUtfDString(NULL,
Tcl_DStringValue(&dstr),
Tcl_DStringLength(&dstr),
- &convdstr); */
-
- Tcl_AppendToObj(outbuf, Tcl_DStringValue(&dstr),
- Tcl_DStringLength(&dstr));
+ &convdstr);
+
+ Tcl_AppendToObj(outbuf, Tcl_DStringValue(&convdstr),
+ Tcl_DStringLength(&convdstr));
Tcl_DStringFree(&dstr);
-/* Tcl_DStringFree(&convdstr); */
+ Tcl_DStringFree(&convdstr);
return inside;
}
1.16 +20 -8 tcl-moddtcl/tcl_commands.c
Index: tcl_commands.c
===================================================================
RCS file: /home/cvs/tcl-moddtcl/tcl_commands.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -r1.15 -r1.16
--- tcl_commands.c 2001/08/08 15:01:51 1.15
+++ tcl_commands.c 2001/09/02 14:04:16 1.16
@@ -84,6 +84,9 @@
}
/* print_headers(globals->r);
flush_output_buffer(globals->r); */
+
+ /* Use Tcl_Read because we don't want to fool with UTF - just read
+ it in and dump it out. */
while ((sz = Tcl_Read(fd, buf, BUFSZ - 1)))
{
if (sz == -1)
@@ -115,7 +118,8 @@
int len;
dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
-
+ Tcl_DString outstring;
+
if (objc < 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "string");
@@ -123,8 +127,10 @@
}
arg1 = Tcl_GetByteArrayFromObj(objv[1], &len);
- memwrite(dsc->obuffer, arg1, len);
+ Tcl_UtfToExternalDString(NULL, arg1, len, &outstring);
+ memwrite(dsc->obuffer, Tcl_DStringValue(&outstring), Tcl_DStringLength(&outstring));
*(dsc->content_sent) = 0;
+ Tcl_DStringFree(&outstring);
return TCL_OK;
}
@@ -135,7 +141,7 @@
char *arg1;
int length;
dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc < 2)
{
@@ -156,11 +162,16 @@
globals->r->server, "Mod_Dtcl Error: %s",
Tcl_GetStringFromObj (objv[2], (int *)NULL));
} else {
+ Tcl_DString outstring;
if (objc != 2)
{
Tcl_WrongNumArgs(interp, 1, objv, "?-error? string");
return TCL_ERROR;
}
+ /* transform it from UTF to External representation */
+ Tcl_UtfToExternalDString(NULL, arg1, length, &outstring);
+ arg1 = Tcl_DStringValue(&outstring);
+ length = Tcl_DStringLength(&outstring);
if (*(dsc->buffer_output) == 1)
{
memwrite(dsc->obuffer, arg1, length);
@@ -169,6 +180,7 @@
flush_output_buffer(globals->r);
ap_rwrite(arg1, length, globals->r);
}
+ Tcl_DStringFree(&outstring);
}
return TCL_OK;
@@ -278,9 +290,9 @@
int Buffered(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
- char *opt = NULL;
+ char *opt = NULL;
dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
- dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
+ dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
if (objc != 2)
{
@@ -662,7 +674,7 @@
return TCL_ERROR;
}
command = Tcl_GetString(objv[1]);
-
+
result = Tcl_NewObj();
if (!strcmp(command, "get"))
{
@@ -795,7 +807,7 @@
upload = ApacheRequest_upload(globals->req);
while (upload)
{
- Tcl_ListObjAppendElement(interp, result,
+ Tcl_ListObjAppendElement(interp, result,
STRING_TO_UTF_TO_OBJ(upload->name, POOL));
upload = upload->next;
}
@@ -836,7 +848,7 @@
int No_Body(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
-
+
dtcl_interp_globals *globals = Tcl_GetAssocData(interp, "dtcl", NULL);
dtcl_server_conf *dsc = (dtcl_server_conf *)ap_get_module_config(globals->r->server->module_config, &dtcl_module);
1.3 +8 -0 tcl-moddtcl/docs/nav.html
Index: nav.html
===================================================================
RCS file: /home/cvs/tcl-moddtcl/docs/nav.html,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- nav.html 2001/08/08 15:01:52 1.2
+++ nav.html 2001/09/02 14:04:16 1.3
@@ -46,6 +46,14 @@
<td><a target="_top" href="http://tcl.apache.org/mod_dtcl/">mod_dtcl
web site</a></td>
</tr>
+ <tr>
+ <td><a target="_top" href="http://tcl.activestate.com/">Tcl
+ web site</a></td>
+ </tr>
+ <tr>
+ <td><a target="_top"
+ href="http://www.apache.org/">Apache web site</a></td>
+ </tr>
</tbody>
</table>
</div>
1.10 +27 -18 tcl-moddtcl/tests/dtcl.test
Index: dtcl.test
===================================================================
RCS file: /home/cvs/tcl-moddtcl/tests/dtcl.test,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- dtcl.test 2001/08/03 14:32:54 1.9
+++ dtcl.test 2001/09/02 14:04:16 1.10
@@ -4,82 +4,86 @@
# mod_dtcl test suite, by David N. Welton <da...@apache.org>
-# $Id: dtcl.test,v 1.9 2001/08/03 14:32:54 davidw Exp $
+# See README file for more information.
+# $Id: dtcl.test,v 1.10 2001/09/02 14:04:16 davidw Exp $
+
package require tcltest
package require http 2.1
set urlbase "http://localhost:8080/"
-set testfilename "dtcl-test2.ttml"
+set testfilename1 "dtcl-test2.ttml"
+set testfilename2 "dtcl-test.tcl"
+
::tcltest::test hello-1.1 {hello world test} {
- set page [ ::http::geturl "${urlbase}$testfilename" ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" ]
regexp -line {^Hello, World$} [ ::http::data $page ]
} 1
::tcltest::test i18n-1.1 {I18N test} {
- set page [ ::http::geturl "${urlbase}$testfilename" ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" ]
regexp -line {^� � � � � � - El Burro Sabe M�s Que T�!$} [ ::http::data $page ]
} 1
::tcltest::test getvariables-1.1 {GET variables} {
- set page [ ::http::geturl "${urlbase}$testfilename?foobar=goober" ]
+ set page [ ::http::geturl "${urlbase}$testfilename1?foobar=goober" ]
regexp -line {^VARS\(foobar\) = goober$} [ ::http::data $page ]
} 1
::tcltest::test getvariables-1.2 {GET variables + I18N} {
- set page [ ::http::geturl "${urlbase}$testfilename?M�s=T�" ]
+ set page [ ::http::geturl "${urlbase}$testfilename1?M�s=T�" ]
regexp -line {^VARS\(M�s\) = T�$} [ ::http::data $page ]
} 1
::tcltest::test getvariables-1.3 {GET variables + I18N + encoding} {
- set page [ ::http::geturl [ format "${urlbase}$testfilename?%s" [ ::http::formatQuery M�s T� ] ] ]
+ set page [ ::http::geturl [ format "${urlbase}$testfilename1?%s" [ ::http::formatQuery M�s T� ] ] ]
regexp -line {^VARS\(M�s\) = T�$} [ ::http::data $page ]
} 1
::tcltest::test postvariables-1.1 {POST variables} {
- set page [ ::http::geturl "${urlbase}$testfilename" -query foobar=goober ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -query foobar=goober ]
regexp -line {^VARS\(foobar\) = goober$} [ ::http::data $page ]
} 1
::tcltest::test postvariables-1.2 {POST variables + I18N} {
- set page [ ::http::geturl "${urlbase}$testfilename" -query M�s=T� ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -query M�s=T� ]
regexp -line {^VARS\(M�s\) = T�$} [ ::http::data $page ]
} 1
::tcltest::test postvariables-1.3 {POST variables + I18N + encoding} {
- set page [ ::http::geturl "${urlbase}$testfilename" -query [ ::http::formatQuery M�s T� ] ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -query [ ::http::formatQuery M�s T� ] ]
regexp -line {^VARS\(M�s\) = T�$} [ ::http::data $page ]
} 1
::tcltest::test multivariables-1.1 {multiple variables: foo=1&foo=2} {
- set page [ ::http::geturl "${urlbase}$testfilename?foobar=1&foobar=2&foobar=foo+bar" ]
+ set page [ ::http::geturl "${urlbase}$testfilename1?foobar=1&foobar=2&foobar=foo+bar" ]
regexp -line {^VARS\(foobar\) = 1 2 foo bar$} [ ::http::data $page ]
} 1
::tcltest::test env-1.1 {Environment variable} {
- set page [ ::http::geturl "${urlbase}$testfilename" ]
- regexp -line "^ENVS\\(DOCUMENT_NAME\\) = $testfilename\$" [ ::http::data $page ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" ]
+ regexp -line "^ENVS\\(DOCUMENT_NAME\\) = $testfilename1\$" [ ::http::data $page ]
} 1
::tcltest::test cookies-1.1 {Cookies} {
- set page [ ::http::geturl "${urlbase}$testfilename" -headers {Cookie "foo=bar"} ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -headers {Cookie "foo=bar"} ]
regexp -line {^COOKIES\(foo\) = bar$} [ ::http::data $page ]
} 1
::tcltest::test cookies-1.2 {Cookies + I18N} {
- set page [ ::http::geturl "${urlbase}$testfilename" -headers {Cookie "M�s=T�"} ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -headers {Cookie "M�s=T�"} ]
regexp -line {^COOKIES\(M�s\) = T�$} [ ::http::data $page ]
} 1
::tcltest::test cookies-1.3 {Cookies + I18N + encoding} {
- set page [ ::http::geturl "${urlbase}$testfilename" -headers [ list Cookie [ ::http::formatQuery M�s T� ] ] ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -headers [ list Cookie [ ::http::formatQuery M�s T� ] ] ]
regexp -line {^COOKIES\(M�s\) = T�$} [ ::http::data $page ]
} 1
::tcltest::test cookies-1.4 {Multiple Cookies} {
set rslt 0
- set page [ ::http::geturl "${urlbase}$testfilename" -headers {Cookie "bop; foo=bar;doo=wah; shoo=be ;doooo=bee;dot=dow "} ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" -headers {Cookie "bop; foo=bar;doo=wah; shoo=be ;doooo=bee;dot=dow "} ]
set pgdata [ ::http::data $page ]
incr rslt [ regexp -line {^COOKIES\(foo\) = bar$} $pgdata ]
incr rslt [ regexp -line {^COOKIES\(doo\) = wah} $pgdata ]
@@ -91,10 +95,15 @@
::tcltest::test servercookies-1.1 {Cookies from Server} {
set rslt 0
- set page [ ::http::geturl "${urlbase}$testfilename" ]
+ set page [ ::http::geturl "${urlbase}$testfilename1" ]
upvar 0 $page state
array set statehash $state(meta)
regexp -line {mod=dtcl; path=[^;]*; expires=01-01-2003} $statehash(Set-Cookie)
} 1
+
+::tcltest::test tclfile-1.1 {Plain .tcl file} {
+ set page [ ::http::geturl "${urlbase}$testfilename2" ]
+ set pgdata [string trim [ ::http::data $page ] ]
+} "� � � � � � - El Burro Sabe M�s Que T�!"
::tcltest::cleanupTests
1.1 tcl-moddtcl/tests/dtcl-test.tcl
Index: dtcl-test.tcl
===================================================================
# test file for plain .tcl files
puts "� � � � � � - El Burro Sabe M�s Que T�!"