Tcl Library Source Code

Check-in [9bbf4e73bb]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Pulling changes from trunk
Timelines: family | ancestors | descendants | both | hypnotoad
Files: files | file ages | folders
SHA3-256: 9bbf4e73bbcb850f51c6b766a7b431a82f08ca25fde6a6dd9d201d9bf95b296e
User & Date: hypnotoad 2017-11-02 18:21:38
Context
2017-11-02
19:44
Pulling changes from trunk check-in: deba870ed0 user: hypnotoad tags: hypnotoad
18:21
Pulling changes from trunk check-in: 9bbf4e73bb user: hypnotoad tags: hypnotoad
18:21
Added a timeout to ::coroutine::util::gets_safety. The delay is setable as a new optional argument. The default is 2 minutes. Refactored the HTTP header parsing system for httpd. Fixed a point where the parser was performing a bare read instead of the coroutine savvy version. Fixed bugs in the httpd test suite. New version of Practcl. Simplified the class structure. Shuffled functions to be closer to be where they are used, and also indicate who calls them. Tcl and Tk now compile in the directory relative to the master project. check-in: e0d0875ab4 user: hypnotoad tags: trunk
10:31
Added a 2 minute timeout for coroutine::util::gets_safety Fixed how line breaks are expressed in the httpd module's tests Refactored how Httpd headers are pulled over a socket to better exploit the fact the process is taking place in a coroutine Bumped practcl's version to 0.10 check-in: 7c6d876842 user: hypnotoad tags: hypnotoad
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to modules/coroutine/coroutine.tcl.

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
                return $line
            }
        }
    }
}


proc ::coroutine::util::gets_safety {chan limit varname} {
    # Process arguments.
    # Acceptable syntax:
    # * gets CHAN ?VARNAME?

    # Loop until we have a complete line. Yield to the event loop
    # where necessary. During
    set blocking [::chan configure $chan -blocking]







|







201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
                return $line
            }
        }
    }
}


proc ::coroutine::util::gets_safety {chan limit varname {timeout 120000}} {
    # Process arguments.
    # Acceptable syntax:
    # * gets CHAN ?VARNAME?

    # Loop until we have a complete line. Yield to the event loop
    # where necessary. During
    set blocking [::chan configure $chan -blocking]
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
	    try {
		set result [::chan gets $chan line]
	    } on error {result opts} {
		return -code $result -options $opts
	    }

	    if {[::chan blocked $chan]} {
	  set timeoutevent [::after 120000 [list [info coroutine] timeout]]
		::chan event $chan readable [list [info coroutine] readable]
		set event [yield]
		if {$event eq "timeout"} {
		  error "Connection Timed Out"
		}
		::after cancel $timeoutevent
		::chan event $chan readable {}







|







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
	    try {
		set result [::chan gets $chan line]
	    } on error {result opts} {
		return -code $result -options $opts
	    }

	    if {[::chan blocked $chan]} {
	  set timeoutevent [::after $timeout [list [info coroutine] timeout]]
		::chan event $chan readable [list [info coroutine] readable]
		set event [yield]
		if {$event eq "timeout"} {
		  error "Connection Timed Out"
		}
		::after cancel $timeoutevent
		::chan event $chan readable {}

Changes to modules/practcl/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded practcl 0.9a0 [list source [file join $dir practcl.tcl]]












|

1
2
3
4
5
6
7
8
9
10
11
12
13
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded practcl 0.10 [list source [file join $dir practcl.tcl]]

Changes to modules/practcl/practcl.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
###
# Amalgamated package for practcl
# Do not edit directly, tweak the source in src/ and rerun
# build.tcl
###
package provide practcl 0.9a0
namespace eval ::practcl {}

###
# START: httpwget/wget.tcl
###
###
# Tool to download file from the web





|







1
2
3
4
5
6
7
8
9
10
11
12
13
###
# Amalgamated package for practcl
# Do not edit directly, tweak the source in src/ and rerun
# build.tcl
###
package provide practcl 0.10
namespace eval ::practcl {}

###
# START: httpwget/wget.tcl
###
###
# Tool to download file from the web
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
# START: class toolset gcc.tcl
###

::oo::class create ::practcl::toolset.gcc {
  superclass ::practcl::toolset

  method build-compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} {
    set objext [my define get OBJEXT .o]
    set EXTERN_OBJS {}
    set OBJECTS {}
    set result {}
    set builddir [$PROJECT define get builddir]
    file mkdir [file join $builddir objs]
    set debug [$PROJECT define get debug 0]
    if {$CPPCOMPILE eq {}} {







|







1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
# START: class toolset gcc.tcl
###

::oo::class create ::practcl::toolset.gcc {
  superclass ::practcl::toolset

  method build-compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} {
    set objext [my define get OBJEXT o]
    set EXTERN_OBJS {}
    set OBJECTS {}
    set result {}
    set builddir [$PROJECT define get builddir]
    file mkdir [file join $builddir objs]
    set debug [$PROJECT define get debug 0]
    if {$CPPCOMPILE eq {}} {
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
  }

method build-Makefile {path PROJECT} {
  array set proj [$PROJECT define dump]
  set path $proj(builddir)
  cd $path
  set includedir .
  set objext [my define get OBJEXT .o]

  #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]]
  foreach include [$PROJECT toolset-include-directory] {
    set cpath [::practcl::file_relative $path [file normalize $include]]
    if {$cpath ni $includedir} {







|







1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
  }

method build-Makefile {path PROJECT} {
  array set proj [$PROJECT define dump]
  set path $proj(builddir)
  cd $path
  set includedir .
  set objext [my define get OBJEXT o]

  #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]]
  foreach include [$PROJECT toolset-include-directory] {
    set cpath [::practcl::file_relative $path [file normalize $include]]
    if {$cpath ni $includedir} {
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
###

::oo::class create ::practcl::library {
  superclass ::practcl::project


  method clean {PATH} {
    set objext [my define get OBJEXT .o]
    foreach {ofile info} [my project-compile-products] {
      if {[file exists [file join $PATH objs $ofile].${objext}]} {
        file delete [file join $PATH objs $ofile].${objext}
      }
    }
    foreach ofile [glob -nocomplain [file join $PATH *.${objext}]] {
      file delete $ofile







|







3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
###

::oo::class create ::practcl::library {
  superclass ::practcl::project


  method clean {PATH} {
    set objext [my define get OBJEXT o]
    foreach {ofile info} [my project-compile-products] {
      if {[file exists [file join $PATH objs $ofile].${objext}]} {
        file delete [file join $PATH objs $ofile].${objext}
      }
    }
    foreach ofile [glob -nocomplain [file join $PATH *.${objext}]] {
      file delete $ofile

Changes to modules/practcl/src/class/project/library.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14

::oo::class create ::practcl::library {
  superclass ::practcl::project


  method clean {PATH} {
    set objext [my define get OBJEXT .o]
    foreach {ofile info} [my project-compile-products] {
      if {[file exists [file join $PATH objs $ofile].${objext}]} {
        file delete [file join $PATH objs $ofile].${objext}
      }
    }
    foreach ofile [glob -nocomplain [file join $PATH *.${objext}]] {
      file delete $ofile






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14

::oo::class create ::practcl::library {
  superclass ::practcl::project


  method clean {PATH} {
    set objext [my define get OBJEXT o]
    foreach {ofile info} [my project-compile-products] {
      if {[file exists [file join $PATH objs $ofile].${objext}]} {
        file delete [file join $PATH objs $ofile].${objext}
      }
    }
    foreach ofile [glob -nocomplain [file join $PATH *.${objext}]] {
      file delete $ofile

Changes to modules/practcl/src/class/toolset/gcc.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13

::oo::class create ::practcl::toolset.gcc {
  superclass ::practcl::toolset

  method build-compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} {
    set objext [my define get OBJEXT .o]
    set EXTERN_OBJS {}
    set OBJECTS {}
    set result {}
    set builddir [$PROJECT define get builddir]
    file mkdir [file join $builddir objs]
    set debug [$PROJECT define get debug 0]
    if {$CPPCOMPILE eq {}} {





|







1
2
3
4
5
6
7
8
9
10
11
12
13

::oo::class create ::practcl::toolset.gcc {
  superclass ::practcl::toolset

  method build-compile-sources {PROJECT COMPILE {CPPCOMPILE {}}} {
    set objext [my define get OBJEXT o]
    set EXTERN_OBJS {}
    set OBJECTS {}
    set result {}
    set builddir [$PROJECT define get builddir]
    file mkdir [file join $builddir objs]
    set debug [$PROJECT define get debug 0]
    if {$CPPCOMPILE eq {}} {
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
  }

method build-Makefile {path PROJECT} {
  array set proj [$PROJECT define dump]
  set path $proj(builddir)
  cd $path
  set includedir .
  set objext [my define get OBJEXT .o]

  #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]]
  foreach include [$PROJECT toolset-include-directory] {
    set cpath [::practcl::file_relative $path [file normalize $include]]
    if {$cpath ni $includedir} {







|







101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
  }

method build-Makefile {path PROJECT} {
  array set proj [$PROJECT define dump]
  set path $proj(builddir)
  cd $path
  set includedir .
  set objext [my define get OBJEXT o]

  #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]]
  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]]
  foreach include [$PROJECT toolset-include-directory] {
    set cpath [::practcl::file_relative $path [file normalize $include]]
    if {$cpath ni $includedir} {