You are viewing a plain text version of this content. The canonical link for it is here.
Posted to rivet-dev@tcl.apache.org by mx...@apache.org on 2012/03/13 19:05:13 UTC
svn commit: r1300262 - in /tcl/rivet/trunk: ./ rivet/packages/simpledb/
rivet/packages/tclrivet/ rivet/rivet-tcl/ src/
Author: mxmanghi
Date: Tue Mar 13 18:05:13 2012
New Revision: 1300262
URL: http://svn.apache.org/viewvc?rev=1300262&view=rev
Log:
* rivet/rivet-tcl/,/rivet/packages/simpledb: various changes suggested by code profiler
(thanks to Harald Oehlmann)
* rivet/packages/tclrivetparse.tcl: wrong handling of swich cases made method 'parse'
unusable
* src/rivet.h: obsolete comment amended
Modified:
tcl/rivet/trunk/ChangeLog
tcl/rivet/trunk/rivet/packages/simpledb/simpledb.tcl
tcl/rivet/trunk/rivet/packages/tclrivet/tclrivet.tcl
tcl/rivet/trunk/rivet/packages/tclrivet/tclrivetparser.tcl
tcl/rivet/trunk/rivet/rivet-tcl/cookie.tcl
tcl/rivet/trunk/rivet/rivet-tcl/html.tcl
tcl/rivet/trunk/rivet/rivet-tcl/import_keyvalue_pairs.tcl
tcl/rivet/trunk/rivet/rivet-tcl/import_switch_args.tcl
tcl/rivet/trunk/rivet/rivet-tcl/lempty.tcl
tcl/rivet/trunk/src/rivet.h
Modified: tcl/rivet/trunk/ChangeLog
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/ChangeLog?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/ChangeLog (original)
+++ tcl/rivet/trunk/ChangeLog Tue Mar 13 18:05:13 2012
@@ -1,3 +1,10 @@
+2012-03-08 Massimo Manghi <mx...@apache.org>
+ * rivet/rivet-tcl/,/rivet/packages/simpledb: various changes suggested by code profiler
+ (thanks to Harald Oehlmann)
+ * rivet/packages/tclrivetparse.tcl: wrong handling of swich cases made method 'parse'
+ unusable
+ * src/rivet.h: obsolete comment amended
+
2012-01-16 Massimo Manghi <mx...@apache.org>
* rivet/rivet-tcl/tclIndex.tcl: regenerated with auto_mkindex.
Modified: tcl/rivet/trunk/rivet/packages/simpledb/simpledb.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/simpledb/simpledb.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/simpledb/simpledb.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/simpledb/simpledb.tcl Tue Mar 13 18:05:13 2012
@@ -194,12 +194,14 @@ proc simpledb::setitem { table oid prope
# Results:
# None.
-proc simpledb::delitem { table oid } {
+proc simpledb::delitem { table oid properties } {
+ upvar $properties props
+
foreach col [array names ${table}::cols] {
- unset ${table}::${col}::data($oid)
- set item [lsearch ${table}::${col}::values($props($col)) $oid]
- set ${table}::${col}::values($props($col)) \
- [lreplace ${table}::${col}::values($props($col)) $item $item]
+ unset ${table}::${col}::data($oid)
+ set item [lsearch ${table}::${col}::values($props($col)) $oid]
+ set ${table}::${col}::values($props($col)) \
+ [lreplace ${table}::${col}::values($props($col)) $item $item]
}
unset ${table}::goodoids($oid)
return $oid
@@ -225,21 +227,21 @@ proc simpledb::delitem { table oid } {
proc simpledb::finditems { table propertymatch } {
array set res {}
foreach {col value} $propertymatch {
- foreach {value oids} [array get ${table}::${col}::values $value] {
- foreach oid $oids {
- if { [info exists res($oid)] } {
- incr res($oid)
- } else {
- set res($oid) 1
- }
- }
- }
+ foreach {value oids} [array get ${table}::${col}::values $value] {
+ foreach oid $oids {
+ if { [info exists res($oid)] } {
+ incr res($oid)
+ } else {
+ set res($oid) 1
+ }
+ }
+ }
}
set retlist {}
foreach {oid num} [array get res] {
- if { $res($oid) == [expr {[llength $propertymatch] / 2}] } {
- lappend retlist $oid
- }
+ if { $res($oid) == [llength $propertymatch] / 2 } {
+ lappend retlist $oid
+ }
}
return $retlist
}
@@ -298,7 +300,7 @@ proc simpledb::synctostorage {savefile}
set collist [array names ${ns}::cols]
puts $fl "namespace eval $ns \{"
puts $fl " array set cols \{ [array get ${ns}::cols] \}"
- puts $fl " array set goodoids \{ [array get ${ns}::goodoids] \}".
+ puts $fl " array set goodoids \{ [array get ${ns}::goodoids] \}"
foreach col $collist {
puts $fl " namespace eval ${col} \{"
puts $fl " array set data [list [array get ${ns}::${col}::data]]"
Modified: tcl/rivet/trunk/rivet/packages/tclrivet/tclrivet.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/tclrivet/tclrivet.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/tclrivet/tclrivet.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/tclrivet/tclrivet.tcl Tue Mar 13 18:05:13 2012
@@ -38,7 +38,6 @@ proc var {} {}
proc var_qs {} {}
proc var_post {} {}
proc upload {} {}
-proc include {} {}
proc parse {} {}
proc no_body {} {}
proc env {} {}
Modified: tcl/rivet/trunk/rivet/packages/tclrivet/tclrivetparser.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/packages/tclrivet/tclrivetparser.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/packages/tclrivet/tclrivetparser.tcl (original)
+++ tcl/rivet/trunk/rivet/packages/tclrivet/tclrivetparser.tcl Tue Mar 13 18:05:13 2012
@@ -45,7 +45,7 @@ proc tclrivetparser::setoutputcmd { {new
variable outputcmd
if { $outputcmd == "" } {
- return $outputcmd
+ return $outputcmd
}
set outputcmd $newcmd
}
@@ -80,69 +80,69 @@ proc tclrivetparser::parse { data outbuf
set len [expr {[string length $data] + 1}]
set next [string index $data 0]
while {$i < $len} {
- incr i
- set cur $next
- set next [string index $data $i]
- if { $inside == 0 } {
- # Outside the delimiting tags.
- if { $cur == [string index $starttag $p] } {
- incr p
- if { $p == [string length $starttag] } {
- append outbuf "\"\n"
- set inside 1
- set p 0
- continue
- }
- } else {
- if { $p > 0 } {
- append outbuf [string range $starttag 0 [expr {$p - 1}]]
- set p 0
- }
- switch -exact -- $cur {
- "\{" {
- append outbuf "\\{"
- }
- "\}" {
- append outbuf "\\}"
- }
- "\$" {
- append outbuf "\\$"
- }
- "\[" {
- append outbuf "\\["
- }
- "\]" {
- append outbuf "\\]"
- }
- "\"" {
- append outbuf "\\\""
- }
- "\\" {
- append outbuf "\\\\"
- }
- default {
- append outbuf $cur
- }
- }
- continue
- }
- } else {
- # Inside the delimiting tags.
- if { $cur == [string index $endtag $p] } {
- incr p
- if { $p == [string length $endtag] } {
- append outbuf "\n$outputcmd \""
- set inside 0
- set p 0
- }
- } else {
- if { $p > 0 } {
- append outbuf [string range $endtag 0 $p]
- set p 0
- }
- append outbuf $cur
- }
- }
+ incr i
+ set cur $next
+ set next [string index $data $i]
+ if { $inside == 0 } {
+ # Outside the delimiting tags.
+ if { $cur == [string index $starttag $p] } {
+ incr p
+ if { $p == [string length $starttag] } {
+ append outbuf "\"\n"
+ set inside 1
+ set p 0
+ continue
+ }
+ } else {
+ if { $p > 0 } {
+ append outbuf [string range $starttag 0 [expr {$p - 1}]]
+ set p 0
+ }
+ switch -exact -- $cur {
+ "\{" {
+ append outbuf \ $cur
+ }
+ "\}" {
+ append outbuf \ $cur
+ }
+ "\$" {
+ append outbuf "\\$"
+ }
+ "\[" {
+ append outbuf "\\["
+ }
+ "\]" {
+ append outbuf "\\]"
+ }
+ "\"" {
+ append outbuf "\\\""
+ }
+ "\\" {
+ append outbuf "\\\\"
+ }
+ default {
+ append outbuf $cur
+ }
+ }
+ continue
+ }
+ } else {
+ # Inside the delimiting tags.
+ if { $cur == [string index $endtag $p] } {
+ incr p
+ if { $p == [string length $endtag] } {
+ append outbuf "\n$outputcmd \""
+ set inside 0
+ set p 0
+ }
+ } else {
+ if { $p > 0 } {
+ append outbuf [string range $endtag 0 $p]
+ set p 0
+ }
+ append outbuf $cur
+ }
+ }
}
return $inside
}
@@ -167,7 +167,7 @@ proc tclrivetparser::parserivetdata { da
set outbuf {}
append outbuf "$outputcmd \""
if { [parse $data outbuf] == 0 } {
- append outbuf "\"\n"
+ append outbuf "\"\n"
}
return $outbuf
}
Modified: tcl/rivet/trunk/rivet/rivet-tcl/cookie.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/cookie.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/cookie.tcl (original)
+++ tcl/rivet/trunk/rivet/rivet-tcl/cookie.tcl Tue Mar 13 18:05:13 2012
@@ -35,14 +35,14 @@ namespace eval ::rivet {
upvar 1 $paramsArray params
set cookieParams ""
- set expiresIn 0
+ set expiresIn 0
if { [info exists params(expires)] } {
append cookieParams "; expires=$params(expires)"
} else {
foreach {time num} [list days 86400 hours 3600 minutes 60] {
- if [info exists params($time)] {
- incr expiresIn [expr $params($time) * $num]
+ if {[info exists params($time)]} {
+ incr expiresIn [expr {$params($time) * $num}]
}
}
if {$expiresIn != 0} {
Modified: tcl/rivet/trunk/rivet/rivet-tcl/html.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/html.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/html.tcl (original)
+++ tcl/rivet/trunk/rivet/rivet-tcl/html.tcl Tue Mar 13 18:05:13 2012
@@ -19,7 +19,7 @@ namespace eval ::rivet {
proc html {string args} {
foreach arg $args { append output <$arg> }
append output $string
- for {set i [expr [llength $args] - 1]} {$i >= 0} {incr i -1} {
+ for {set i [expr {[llength $args] - 1} ]} {$i >= 0} {incr i -1} {
append output </[lindex [lindex $args $i] 0]>
}
puts $output
Modified: tcl/rivet/trunk/rivet/rivet-tcl/import_keyvalue_pairs.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/import_keyvalue_pairs.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/import_keyvalue_pairs.tcl (original)
+++ tcl/rivet/trunk/rivet/rivet-tcl/import_keyvalue_pairs.tcl Tue Mar 13 18:05:13 2012
@@ -37,7 +37,7 @@ namespace eval ::rivet {
if {$arg == "--"} {
# "--" appears as an argument, store the rest of the arg list
# in the args element of the array
- set data(args) [lrange $argsList [expr $index + 1] end]
+ set data(args) [lrange $argsList [expr {$index + 1} ] end]
break
}
Modified: tcl/rivet/trunk/rivet/rivet-tcl/import_switch_args.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/import_switch_args.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/import_switch_args.tcl (original)
+++ tcl/rivet/trunk/rivet/rivet-tcl/import_switch_args.tcl Tue Mar 13 18:05:13 2012
@@ -27,7 +27,7 @@ namespace eval ::rivet {
set array(args) [lrange $argsList $index end]
break
} elseif {$arg == "--"} {
- set array(args) [lrange $argsList [expr $index + 1] end]
+ set array(args) [lrange $argsList [expr {$index + 1}] end]
break
}
Modified: tcl/rivet/trunk/rivet/rivet-tcl/lempty.tcl
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/rivet/rivet-tcl/lempty.tcl?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/rivet/rivet-tcl/lempty.tcl (original)
+++ tcl/rivet/trunk/rivet/rivet-tcl/lempty.tcl Tue Mar 13 18:05:13 2012
@@ -12,7 +12,7 @@ namespace eval ::rivet {
proc lempty {list} {
if {[catch {llength $list} len]} { return 0 }
- return [expr $len == 0]
+ return [expr {$len == 0}]
}
}
Modified: tcl/rivet/trunk/src/rivet.h
URL: http://svn.apache.org/viewvc/tcl/rivet/trunk/src/rivet.h?rev=1300262&r1=1300261&r2=1300262&view=diff
==============================================================================
--- tcl/rivet/trunk/src/rivet.h (original)
+++ tcl/rivet/trunk/src/rivet.h Tue Mar 13 18:05:13 2012
@@ -41,10 +41,10 @@ Tcl_CreateObjCommand( interp, /* Tcl int
NULL, /* Client Data */\
(Tcl_CmdDeleteProc *)NULL /* Tcl Delete Prov */)
-/* RIVET_OBJ_CMD creates a command in the RIVET_NS namespace and
- * it also exports the command using the Tcl_Export function. This
- * is suboptimal, rivet_ns must point to a Tcl_Namespace structure
- * created somewhere before the macro is called.
+/* RIVET_OBJ_CMD creates a command in the RIVET_NS namespace. Commands
+ * are exported from the RIVET_NS (::rivet) namespace in the init.tcl
+ * script accordingly to configuration switches passed to ./configure
+ * (see configure.ac)
*/
#define RIVET_OBJ_CMD(name,func) \
---------------------------------------------------------------------
To unsubscribe, e-mail: rivet-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: rivet-cvs-help@tcl.apache.org