From 1cf89a4ff13dced7875e82e90c4e67976301661c Mon Sep 17 00:00:00 2001 From: "donal.k.fellows@manchester.ac.uk" Date: Tue, 22 Oct 2013 18:55:02 +0000 Subject: [3556215]: Made [scan] match [format] better in what it accepts as a format string, by allowing uppercase %X, %E and %G. --- doc/scan.n | 4 ++-- generic/tclScan.c | 6 ++++++ tests/scan.test | 17 +++++++++++++---- 3 files changed, 21 insertions(+), 6 deletions(-) diff --git a/doc/scan.n b/doc/scan.n index ca096da..4ee9a59 100644 --- a/doc/scan.n +++ b/doc/scan.n @@ -96,7 +96,7 @@ The input substring must be an octal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. .TP 10 -\fBx\fR +\fBx\fR or \fBX\fR The input substring must be a hexadecimal integer. It is read in and the integer value is stored in the variable, truncated as required by the size modifier value. @@ -126,7 +126,7 @@ substring may be a white-space character. The input substring consists of all the characters up to the next white-space character; the characters are copied to the variable. .TP 10 -\fBe\fR or \fBf\fR or \fBg\fR +\fBe\fR or \fBf\fR or \fBg\fR or \fBE\fR or \fBG\fR The input substring must be a floating-point number consisting of an optional sign, a string of decimal digits possibly containing a decimal point, and an optional exponent consisting diff --git a/generic/tclScan.c b/generic/tclScan.c index d83c8c9..229f3fa 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -398,11 +398,14 @@ ValidateFormat( */ case 'd': case 'e': + case 'E': case 'f': case 'g': + case 'G': case 'i': case 'o': case 'x': + case 'X': break; case 'u': if (flags & SCAN_BIG) { @@ -727,6 +730,7 @@ Tcl_ScanObjCmd( parseFlag |= TCL_PARSE_OCTAL_ONLY | TCL_PARSE_SCAN_PREFIXES; break; case 'x': + case 'X': op = 'i'; parseFlag |= TCL_PARSE_HEXADECIMAL_ONLY; break; @@ -738,7 +742,9 @@ Tcl_ScanObjCmd( case 'f': case 'e': + case 'E': case 'g': + case 'G': op = 'f'; break; diff --git a/tests/scan.test b/tests/scan.test index d7b72d5..109746f 100644 --- a/tests/scan.test +++ b/tests/scan.test @@ -280,6 +280,12 @@ test scan-4.48 {Tcl_ScanObjCmd, float scanning} { test scan-4.49 {Tcl_ScanObjCmd, float scanning} { list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z } {3 0.1 0.2 3.0} +test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} { + list [scan {0.5*0.75} {%E%c%G} x y z] $x $y $z +} {3 0.5 42 0.75} +test scan-4.49-uc-2 {Tcl_ScanObjCmd, float scanning} { + list [scan {5e-1*75E-2} {%E%c%G} x y z] $x $y $z +} {3 0.5 42 0.75} test scan-4.50 {Tcl_ScanObjCmd, float scanning} { list [scan {1234567890a} %f x] $x } {1 1234567890.0} @@ -359,6 +365,9 @@ test scan-4.63 {scanning of large and negative hex integers} { list [scan $scanstring {%x %x %x} a b c] \ [expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }] } {3 1 1 1} +test scan-4.64 {scanning of hex with %X} { + scan "123 abc f78" %X%X%X +} {291 2748 3960} # clean up from last two tests @@ -515,14 +524,14 @@ test scan-8.4 {error conditions} { list [catch {scan a %O x} msg] $msg } {1 {bad scan conversion character "O"}} test scan-8.5 {error conditions} { - list [catch {scan a %X x} msg] $msg -} {1 {bad scan conversion character "X"}} + list [catch {scan a %B x} msg] $msg +} {1 {bad scan conversion character "B"}} test scan-8.6 {error conditions} { list [catch {scan a %F x} msg] $msg } {1 {bad scan conversion character "F"}} test scan-8.7 {error conditions} { - list [catch {scan a %E x} msg] $msg -} {1 {bad scan conversion character "E"}} + list [catch {scan a %p x} msg] $msg +} {1 {bad scan conversion character "p"}} test scan-8.8 {error conditions} { list [catch {scan a "%d %d" a} msg] $msg } {1 {different numbers of variable names and field specifiers}} -- cgit v0.12 From 9b149b8caf458158582d8fdc8184212616adda54 Mon Sep 17 00:00:00 2001 From: "dgp@users.sourceforge.net" Date: Wed, 23 Oct 2013 15:32:58 +0000 Subject: silence compiler warning --- generic/tclCompile.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index dcd74f1..3c8e4ef 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -4034,7 +4034,6 @@ TclEmitInvoke( int savedStackDepth = envPtr->currStackDepth; int savedExpandCount = envPtr->expandCount; JumpFixup nonTrapFixup; - ExceptionAux *exceptAux = envPtr->exceptAuxArrayPtr + loopRange; if (auxBreakPtr != NULL) { auxBreakPtr = envPtr->exceptAuxArrayPtr + breakRange; -- cgit v0.12 From 4dfcda84c40ff14722abc80d5f16d4c31c54b3ca Mon Sep 17 00:00:00 2001 From: "nijtmans@users.sourceforge.net" Date: Fri, 25 Oct 2013 12:57:19 +0000 Subject: Fix [3eb2ec1449]: Allow upper case scheme names in url. http -> 2.7.13 --- library/http/http.tcl | 21 ++++++++++++--------- library/http/pkgIndex.tcl | 2 +- tests/http.test | 4 ++-- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 5 files changed, 19 insertions(+), 16 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 98d2c5d..4c99f62 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.4 # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.7.12 +package provide http 2.7.13 namespace eval http { # Allow resourcing to not clobber existing data @@ -107,7 +107,7 @@ proc http::Log {args} {} proc http::register {proto port command} { variable urlTypes - set urlTypes($proto) [list $port $command] + set urlTypes([string tolower $proto]) [list $port $command] } # http::unregister -- @@ -121,11 +121,12 @@ proc http::register {proto port command} { proc http::unregister {proto} { variable urlTypes - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { return -code error "unsupported url type \"$proto\"" } - set old $urlTypes($proto) - unset urlTypes($proto) + set old $urlTypes($lower) + unset urlTypes($lower) return $old } @@ -505,12 +506,13 @@ proc http::geturl {url args} { if {$proto eq ""} { set proto http } - if {![info exists urlTypes($proto)]} { + set lower [string tolower $proto] + if {![info exists urlTypes($lower)]} { unset $token return -code error "Unsupported URL type \"$proto\"" } - set defport [lindex $urlTypes($proto) 0] - set defcmd [lindex $urlTypes($proto) 1] + set defport [lindex $urlTypes($lower) 0] + set defcmd [lindex $urlTypes($lower) 1] if {$port eq ""} { set port $defport @@ -641,7 +643,8 @@ proc http::Connected { token proto phost srvurl} { set host [lindex [split $state(socketinfo) :] 0] set port [lindex [split $state(socketinfo) :] 1] - set defport [lindex $urlTypes($proto) 0] + set lower [string tolower $proto] + set defport [lindex $urlTypes($lower) 0] # Send data in cr-lf format, but accept any line terminators diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 0157b3c..be8b883 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,4 +1,4 @@ # Tcl package index file, version 1.1 if {![package vsatisfies [package provide Tcl] 8.4]} {return} -package ifneeded http 2.7.12 [list tclPkgSetup $dir http 2.7.12 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.7.13 [list tclPkgSetup $dir http 2.7.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/tests/http.test b/tests/http.test index c974990..81e16a1 100644 --- a/tests/http.test +++ b/tests/http.test @@ -120,7 +120,7 @@ test http-3.2 {http::geturl} { set err } {Unsupported URL: http:junk} set url //[info hostname]:$port -set badurl //[info hostname]:6666 +set badurl //[info hostname]:[expr $port+1] test http-3.3 {http::geturl} { set token [http::geturl $url] http::data $token @@ -130,7 +130,7 @@ test http-3.3 {http::geturl} { " set tail /a/b/c set url //[info hostname]:$port/a/b/c -set fullurl http://user:pass@[info hostname]:$port/a/b/c +set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost diff --git a/unix/Makefile.in b/unix/Makefile.in index f6c4424..7c567d3 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -766,8 +766,8 @@ install-libraries: libraries $(INSTALL_TZDATA) install-msgs do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \ done; - @echo "Installing package http 2.7.12 as a Tcl Module"; - @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.12.tm; + @echo "Installing package http 2.7.13 as a Tcl Module"; + @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/http-2.7.13.tm; @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"; @for i in $(TOP_DIR)/library/opt/*.tcl ; \ do \ diff --git a/win/Makefile.in b/win/Makefile.in index 2d97807..7d9e844 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -642,8 +642,8 @@ install-libraries: libraries install-tzdata install-msgs do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \ done; - @echo "Installing package http 2.7.12 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.12.tm; + @echo "Installing package http 2.7.13 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/http-2.7.13.tm; @echo "Installing library opt0.4 directory"; @for j in $(ROOT_DIR)/library/opt/*.tcl; \ do \ -- cgit v0.12 From bfc636bc160dba7fee1ea3fe65543289e2c61365 Mon Sep 17 00:00:00 2001 From: "donal.k.fellows@manchester.ac.uk" Date: Sun, 27 Oct 2013 08:28:43 +0000 Subject: [53a917d6c9]: Correction to macro for determining how to deprecate things. Thanks to Raphael Kubo da Costa for the patch. --- generic/tcl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index 1b120fb..ab54078 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -168,7 +168,7 @@ extern "C" { */ #if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1))) -# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5)) +# if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ >= 5)) # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__ (msg))) # else # define TCL_DEPRECATED_API(msg) __attribute__ ((__deprecated__)) -- cgit v0.12