Index: openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl,v diff -u -r1.1.2.38 -r1.1.2.39 --- openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl 20 Jul 2022 11:45:57 -0000 1.1.2.38 +++ openacs-4/packages/acs-tcl/tcl/01-database-procs.tcl 29 Jul 2022 17:27:37 -0000 1.1.2.39 @@ -1622,7 +1622,7 @@ if { ![info exists column_set] } { if { [info exists column_array] } { unset -nocomplain array_val - array set array_val [lmap a $columns v $tuple {list $a $v}] + array set array_val [concat {*}[lmap a $columns v $tuple {list $a $v}]] } else { foreach a $columns v $tuple { uplevel [list set $a $v] } } Index: openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl,v diff -u -r1.1.2.24 -r1.1.2.25 --- openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl 27 Jul 2022 13:54:20 -0000 1.1.2.24 +++ openacs-4/packages/acs-tcl/tcl/test/db-proc-test-procs.tcl 29 Jul 2022 17:27:37 -0000 1.1.2.25 @@ -109,17 +109,31 @@ # 3 columns set results "" - db_foreach query {select * from (values ('a1','b1','c1')) as X(a,b,c)} -column_array things { - set results [lsort [array get things]] + db_foreach query {select * from (values ('a1','b1','c 1')) as X(a,b,c)} { + lappend results [list a $a b $b c $c] } - aa_equals "db_foreach with three columns" "{a a1} {b b1} {c c1}" $results + aa_equals "db_foreach with three columns instvars" "{a a1 b b1 c {c 1}}" $results + set results "" + db_foreach query {select * from (values ('a1','b1','c 1')) as X(a,b,c)} \ + -column_array things { + lappend results [lsort [array get things]] + } + aa_equals "db_foreach with three columns" "{a a1 b b1 c {c 1}}" $results + # 4 columns set results "" - db_foreach query {select * from (values ('a1','b1','c1','d1')) as X(a,b,c,d)} -column_array things { - set results [lsort [array get things]] + db_foreach query {select * from (values ('a1','b1','c 1','d1')) as X(a,b,c,d)} { + lappend results [list a $a b $b c $c d $d] } - aa_equals "db_foreach with four columns" "{a a1} {b b1} {c c1} {d d1}" $results + aa_equals "db_foreach with fopur columns instvars" "{a a1 b b1 c {c 1} d d1}" $results + + set results "" + db_foreach query {select * from (values ('a1','b1','c 1','d1')) as X(a,b,c,d)} \ + -column_array things { + lappend results [lsort [array get things]] + } + aa_equals "db_foreach with four columns" "{a a1 b b1 c {c 1} d d1}" $results } aa_register_case \