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/08/03 16:32:54 UTC

cvs commit: tcl-moddtcl/tests makeconf.tcl runtests.tcl template.conf.tcl README dtcl-test2.ttml dtcl.test

davidw      01/08/03 07:32:54

  Modified:    .        mod_dtcl.c tcl_commands.c
               tests    README dtcl-test2.ttml dtcl.test
  Added:       tests    makeconf.tcl runtests.tcl template.conf.tcl
  Log:
  Switched to Tcl_ReadChars from Tcl_Read.
  Added more advanced (?) testing system which attempts to run self-contained.
  Changed COOKIE code to fix possible bug in i18n.  Don't know if fix is correct.
  
  Revision  Changes    Path
  1.44      +2 -12     tcl-moddtcl/mod_dtcl.c
  
  Index: mod_dtcl.c
  ===================================================================
  RCS file: /home/cvs/tcl-moddtcl/mod_dtcl.c,v
  retrieving revision 1.43
  retrieving revision 1.44
  diff -u -r1.43 -r1.44
  --- mod_dtcl.c	2001/07/21 15:56:22	1.43
  +++ mod_dtcl.c	2001/08/03 14:32:54	1.44
  @@ -57,7 +57,7 @@
    * originally written at the National Center for Supercomputing Applications,
    * University of Illinois, Urbana-Champaign.  */
   
  -/* $Id: mod_dtcl.c,v 1.43 2001/07/21 15:56:22 davidw Exp $  */
  +/* $Id: mod_dtcl.c,v 1.44 2001/08/03 14:32:54 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. */
  @@ -331,9 +331,7 @@
   	goto error;
       }
   
  -    cmdBuffer = (char *) malloc(r->finfo.st_size + 1);
  -
  -    result = Tcl_Read(chan, cmdBuffer, r->finfo.st_size);
  +    result = Tcl_ReadChars(chan, outbuf, r->finfo.st_size, 1);
       if (result < 0)
       {
   	Tcl_Close(interp, chan);
  @@ -341,14 +339,10 @@
   			 "\": ", Tcl_PosixError(interp), (char *) NULL);
   	goto error;
       }
  -    cmdBuffer[result] = 0;
   
       if (Tcl_Close(interp, chan) != TCL_OK)
   	goto error;
   
  -    Tcl_SetStringObj(outbuf, cmdBuffer, strlen(cmdBuffer));
  -    free(cmdBuffer);
  -
       /* yuck  */
       goto end;
   error:
  @@ -967,10 +961,6 @@
       newdsc->objCache = olddsc->objCache;
       newdsc->namespacePrologue = olddsc->namespacePrologue;
   
  -    newdsc->buffer_output = olddsc->buffer_output;
  -    newdsc->headers_printed = olddsc->headers_printed;
  -    newdsc->headers_set = olddsc->headers_set;
  -    newdsc->content_sent = olddsc->content_sent;
       newdsc->buffer_output = olddsc->buffer_output;
       newdsc->headers_printed = olddsc->headers_printed;
       newdsc->headers_set = olddsc->headers_set;
  
  
  
  1.14      +4 -2      tcl-moddtcl/tcl_commands.c
  
  Index: tcl_commands.c
  ===================================================================
  RCS file: /home/cvs/tcl-moddtcl/tcl_commands.c,v
  retrieving revision 1.13
  retrieving revision 1.14
  diff -u -r1.13 -r1.14
  --- tcl_commands.c	2001/06/29 16:38:00	1.13
  +++ tcl_commands.c	2001/08/03 14:32:54	1.14
  @@ -439,8 +439,10 @@
   		char *name = c->name;
   		char *value = ApacheCookieFetch(c, j);
   		Tcl_ObjSetVar2(interp, cookieobj,
  -			       STRING_TO_UTF_TO_OBJ(name, POOL),
  -			       STRING_TO_UTF_TO_OBJ(value, POOL), 0);
  +			       Tcl_NewStringObj(name, -1),
  +			       Tcl_NewStringObj(value, -1), 0);
  +/* 			       STRING_TO_UTF_TO_OBJ(name, POOL),
  +			       STRING_TO_UTF_TO_OBJ(value, POOL), 0);  */
   	    }
   
   	}
  
  
  
  1.3       +7 -9      tcl-moddtcl/tests/README
  
  Index: README
  ===================================================================
  RCS file: /home/cvs/tcl-moddtcl/tests/README,v
  retrieving revision 1.2
  retrieving revision 1.3
  diff -u -r1.2 -r1.3
  --- README	2001/05/21 19:49:28	1.2
  +++ README	2001/08/03 14:32:54	1.3
  @@ -1,6 +1,6 @@
   Test Suite for mod_dtcl
   
  -$Id: README,v 1.2 2001/05/21 19:49:28 davidw Exp $
  +$Id: README,v 1.3 2001/08/03 14:32:54 davidw Exp $
   
   These tests are intended to automate the testing of core mod_dtcl
   features.  They are not complete at this point, and work on them would
  @@ -8,13 +8,11 @@
   
   How to run the tests:
   
  -Assuming you have a system which runs mod_dtcl, put the dtcl-test.ttml
  -file somewhere under your document root, and modify this line:
  +The program 'runtest.tcl' is launched with the full path to the apache
  +web server.  It then creates a minimal config file in the directory it
  +is launched from, and launches Apache with the generated config.  We
  +are thusly able to manipulate the environment completely, and run the
  +tests directly in the tests/ directory...
   
  -set urlbase "http://localhost/"
  +Note that mod_so.c must be compiled into Apache for this to work.
   
  -to something like
  -
  -set urlbase "http://path.to.testfile.com/mytests/"
  -
  -Then run dtcl.test, and look and see if any of the tests fail.
  
  
  
  1.2       +1 -2      tcl-moddtcl/tests/dtcl-test2.ttml
  
  Index: dtcl-test2.ttml
  ===================================================================
  RCS file: /home/cvs/tcl-moddtcl/tests/dtcl-test2.ttml,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- dtcl-test2.ttml	2001/05/21 19:49:30	1.1
  +++ dtcl-test2.ttml	2001/08/03 14:32:54	1.2
  @@ -1,7 +1,6 @@
   <?
  -# $Id: dtcl-test2.ttml,v 1.1 2001/05/21 19:49:30 davidw Exp $
  +# $Id: dtcl-test2.ttml,v 1.2 2001/08/03 14:32:54 davidw Exp $
   # dtcl page used with mod_dtcl's dtcl.test
  -# place in DocumentRoot of http://localhost/
   
   hgetvars
   
  
  
  
  1.9       +5 -3      tcl-moddtcl/tests/dtcl.test
  
  Index: dtcl.test
  ===================================================================
  RCS file: /home/cvs/tcl-moddtcl/tests/dtcl.test,v
  retrieving revision 1.8
  retrieving revision 1.9
  diff -u -r1.8 -r1.9
  --- dtcl.test	2001/05/21 19:49:30	1.8
  +++ dtcl.test	2001/08/03 14:32:54	1.9
  @@ -1,13 +1,15 @@
  -#!/usr/bin/tclsh
  +#!/bin/sh
  +# the next line restarts using tclsh \
  +exec tclsh "$0" "$@"
   
   # mod_dtcl test suite, by David N. Welton <da...@apache.org>
   
  -# $Id: dtcl.test,v 1.8 2001/05/21 19:49:30 davidw Exp $ 
  +# $Id: dtcl.test,v 1.9 2001/08/03 14:32:54 davidw Exp $ 
   
   package require tcltest
   package require http 2.1
   
  -set urlbase "http://localhost/"
  +set urlbase "http://localhost:8080/"
   set testfilename "dtcl-test2.ttml"
   
   ::tcltest::test hello-1.1 {hello world test} {
  
  
  
  1.1                  tcl-moddtcl/tests/makeconf.tcl
  
  Index: makeconf.tcl
  ===================================================================
  #!/usr/bin/tclsh
  
  proc getbinname { } {
      global argv
      set binname [ lindex $argv 0 ]
      if { $binname == "" || ! [ file exists $binname ] } {
  	puts stderr "Please supply the full name and path of the Apache executable on the command line!"
  	exit 1
      }
      return $binname
  }
  
  # the modules we need and their '.c' names
  array set module_assoc {
      mod_log_config	config_log_module 
      mod_mime		mime_module 
      mod_negotiation	negotiation_module 
      mod_dir		dir_module 
      mod_access		access_module 
      mod_auth		auth_module
  }    
      
  # get the modules that are compiled into Apache directly, and return
  # the _module name.  Check also for the existence of mod_so, which we
  # need to load mod_dtcl.so in the directory above...
  
  proc getcompiledin { binname } {
      global module_assoc
      set bin [ open [list | "$binname" -l ] r ]
      set compiledin [ read $bin ]
      close $bin
      set modlist [ split $compiledin ]
      set compiledin [list]
      set mod_so_present 0
      foreach entry $modlist {
  	if { [regexp {(.*)\.c$} $entry match modname] } {
  	    if { $modname == "mod_so" } { set mod_so_present 1 }
  	    if { [ info exists module_assoc($modname) ] } {
  		lappend compiledin $module_assoc($modname)
  	    }
  	}
      }
      if { $mod_so_present == 0 } {
  	puts stderr "We need mod_so in Apache to run these tests"
  	exit 1
      }
      return $compiledin
  }
  
  # find the httpd.conf file
  
  proc gethttpdconf { binname } {
      set bin [ open [list | "$binname" -V ] r ]
      set options [ read $bin ]
      close $bin
      regexp {SERVER_CONFIG_FILE="(.*?)"} "$options" match filename
      if { ! [ file exists $filename ] } {
  	# see if we can find something by combining HTTP_ROOT + SERVER_CONFIG_FILE
  	regexp {HTTPD_ROOT="(.*?)"} "$options" match httpdroot
  	set completename "$httpdroot/$filename"
  	if { ! [ file exists $completename ] } {
  	    puts stderr "neither '$filename' or '$completename' exists"
  	    exit 1
  	} 
  	return $completename
      }
      return $filename
  }
  
  # if we need to load some modules, find out how to do it from the
  # 'real' conf file, with this proc
  
  proc getloadmodules { conffile needtoget } {
      set fl [ open $conffile r ]
      set confdata [ read $fl ]
      close $fl
      set loadline [list]
      foreach mod $needtoget {
  	if { ! [ regexp -line "^.*?(LoadModule\\s+$mod\\s+.+)\$" $confdata match line ] } {
  	    puts stderr "No LoadModule line for $mod!"
  	    exit 1
  	} else {
  	    lappend loadline $line
  	}
      }
      return [join $loadline "\n"]
  }
  
  # compare what's compiled in with what we need
  
  proc determinemodules { binname } {
      global module_assoc
      set compiledin [lsort [ getcompiledin $binname ]]
      set conffile [ gethttpdconf $binname ]
  
      foreach {n k} [ array get module_assoc ] {
  	lappend needed $k
      }
      set needed [lsort $needed]
  
      set needtoget [list]
      foreach mod $needed {
  	if { [ lsearch $compiledin $mod ] == -1 } {
  	    lappend needtoget $mod
  	}
      }
      if { $needtoget == "" } {
  	return ""
      } else {
  	return [ getloadmodules $conffile $needtoget ]
      }
  }
  
  # dump out a config
  
  proc makeconf { binname outfile } {
      set CWD [ pwd ]
  
      # replace with determinemodules
      set LOADMODULES [ determinemodules $binname ]
      
      set fl [ open "template.conf.tcl" r ]
      set template [ read $fl ]
      close $fl
  
      set out [ subst $template ]
      
      set of [ open $outfile w ]
      puts $of "$out"
      close $of
  }
  #makeconf [ getbinname ]
  #puts [ determinemodules $binname ]
  #gethttpdconf $binname
  #getcompiledin $binname
  
  
  1.1                  tcl-moddtcl/tests/runtests.tcl
  
  Index: runtests.tcl
  ===================================================================
  #!/bin/sh
  # the next line restarts using tclsh \
  exec tclsh "$0" "$@"
  
  source makeconf.tcl
  
  set binname [ getbinname ]
  
  makeconf $binname server.conf
  
  set apachepid [ exec $binname -X -f "[pwd]/server.conf" & ]
  set oput [ exec ./dtcl.test ]
  puts $oput
  exec kill $apachepid
  
  
  
  1.1                  tcl-moddtcl/tests/template.conf.tcl
  
  Index: template.conf.tcl
  ===================================================================
  # \$Id\$
  # Minimal config file for testing
  
  # Parsed by makeconf.tcl
  
  ServerType standalone
  
  ServerRoot "$CWD"
  
  PidFile "$CWD/httpd.pid"
  
  # ScoreBoardFile "$CWD/apache_runtime_status"
  
  ResourceConfig "$CWD/srm.conf"
  AccessConfig "$CWD/access.conf"
  
  Timeout 300
  
  MaxRequestsPerChild 100
  
  $LOADMODULES
  
  LoadModule dtcl_module $CWD/../mod_dtcl[info sharedlibextension]
  
  Port 8080
  
  ServerName localhost
  
  DocumentRoot "$CWD"
  
  <Directory "$CWD">
  Options All MultiViews 
  AllowOverride All
  Order allow,deny
  Allow from all
  </Directory>
  
  <IfModule mod_dir.c>
  DirectoryIndex index.html
  </IfModule>
  
  AccessFileName .htaccess
  
  HostnameLookups Off
  
  ErrorLog $CWD/error_log
  
  LogLevel debug
  
  LogFormat "%h %l %u %t \\"%r\\" %>s %b \\"%{Referer}i\\" \\"%{User-Agent}i\\"" combined
  CustomLog /home/davidw/install/apache-1.3/logs/access_log combined
  
  <IfModule mod_mime.c>
  AddLanguage en .en
  AddLanguage it .it
  AddLanguage es .es
  AddType application/x-httpd-tcl .ttml
  AddType application/x-dtcl-tcl .tcl
  </IfModule>