tcl-mod_dtcl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From dav...@apache.org
Subject cvs commit: tcl-moddtcl/tests dtcl-test.tcl dtcl.test dtcl-test.ttml
Date Sun, 02 Sep 2001 14:04:16 GMT
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 <davidw@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 <davidw@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ú!"
  
  
  

Mime
View raw message