###############################################################################
#
# types.eagle --
#
# Written by Joe Mistachkin.
# Released to the public domain, use at your own risk!
#
###############################################################################
package require Eagle
package require Eagle.Library
package require Eagle.Test
runTestPrologue
###############################################################################
package require System.Data.SQLite.Test
runSQLiteTestPrologue
###############################################################################
proc bindValueCallback1 {
convert command flags parameter typeName index userData
completeVarName } {
lappend ::log(bind) [list convert [isObjectHandle $convert]]
lappend ::log(bind) [list command [isObjectHandle $command]]
lappend ::log(bind) [list flags [getStringFromObjectHandle $flags]]
lappend ::log(bind) [list parameter [isObjectHandle $parameter]]
lappend ::log(bind) [list typeName [getStringFromObjectHandle $typeName]]
lappend ::log(bind) [list index [getStringFromObjectHandle $index]]
lappend ::log(bind) [list userData [getStringFromObjectHandle $userData]]
if {[getStringFromObjectHandle $userData] == 3} then {
upvar 1 $completeVarName complete; unset complete
error "parameter binding canceled"
}
if {[getStringFromObjectHandle $userData] == 2} then {
$parameter DbType String
$parameter Value custom
}
if {[getStringFromObjectHandle $userData] == 1} then {
upvar 1 $completeVarName complete
set complete [object invoke -create System.Boolean Parse True]
}
}
###############################################################################
proc readValueCallback1 {
convert dataReader flags eventArgs typeName index userData
completeVarName } {
lappend ::log(read) [list convert [isObjectHandle $convert]]
lappend ::log(read) [list dataReader [isObjectHandle $dataReader]]
lappend ::log(read) [list flags [getStringFromObjectHandle $flags]]
lappend ::log(read) [list eventArgs [isObjectHandle $eventArgs]]
lappend ::log(read) [list typeName [getStringFromObjectHandle $typeName]]
lappend ::log(read) [list index [getStringFromObjectHandle $index]]
lappend ::log(read) [list userData [getStringFromObjectHandle $userData]]
if {[getStringFromObjectHandle $userData] == 3} then {
upvar 1 $completeVarName complete; unset complete
error "reading of value canceled"
}
if {[getStringFromObjectHandle $userData] == 1} then {
upvar 1 $completeVarName complete
set complete [object invoke -create System.Boolean Parse True]
}
}
###############################################################################
runTest {test types-1.1 {type callbacks management} -setup {
setupDb [set fileName types-1.1.db]
} -body {
set connection [getDbConnection]
set result [list]
lappend result [$connection ClearTypeCallbacks]
set typeCallbacks(1) [object invoke \
System.Data.SQLite.SQLiteTypeCallbacks Create \
null null null null]
set typeCallbacks(2) null
lappend result [$connection SetTypeCallbacks TEST $typeCallbacks(1)]
lappend result [$connection TryGetTypeCallbacks TEST typeCallbacks(2)]
lappend result [$connection ClearTypeCallbacks]
lappend result [$connection SetTypeCallbacks TEST $typeCallbacks(1)]
lappend result [expr {$typeCallbacks(1) eq $typeCallbacks(2)}]
set result
} -cleanup {
freeDbConnection
cleanupDb $fileName
unset -nocomplain typeCallbacks
unset -nocomplain result connection db fileName
} -constraints {eagle command.object monoBug28 command.sql compile.DATA SQLite\
System.Data.SQLite} -result {0 True True 1 True True}}
###############################################################################
set readArgs [list \
convert dataReader flags eventArgs typeName index userData \
completeVarName]
set params [list \
[list Boolean GetBoolean false BooleanValue true 0] \
[list Byte GetByte false ByteValue true 0] \
[list Byte GetBytes true BytesValue false 0] \
[list Char GetChar false CharValue true 0] \
[list Char GetChars true CharsValue false 0] \
[list DateTime GetDateTime false DateTimeValue true 0] \
[list Decimal GetDecimal false DecimalValue true 0] \
[list Double GetDouble false DoubleValue true 0] \
[list Single GetFloat false FloatValue true 0] \
[list Guid GetGuid false GuidValue true \
00000000-0000-0000-0000-000000000000] \
[list Int16 GetInt16 false Int16Value true 0] \
[list Int32 GetInt32 false Int32Value true 0] \
[list Int64 GetInt64 false Int64Value true 0] \
[list String GetString false StringValue false none] \
[list Object GetValue false Value false null] \
[list SDS.SQLiteBlob GetBlob false BlobValue false 0]]
###############################################################################
set expectedResults [list \
{False False True False False False False False} \
{0 0 1 0 0 0 0 0} \
{0 1 48 1 49 3 {49 46 50} 5 {116 104 114\
101 101} 1 4 27 {50 48 49 54 45 48 54\
45 49 57 32 49 57 58 53 48 58 48 52 46\
49 50 51 52 53 54 55} 36 {55 52 102 49\
102 52 48 50 45 100 100 101 102 45 52\
48 50 55 45 97 55 56 102 45 51 56 52 55\
102 97 57 55 98 56 51 48}} \
"<NUL> <NUL> \x01 <NUL> <NUL> <NUL> <NUL> <NUL>" \
"0 1 0 1 1 3 {1 . 2} 1 t 1 \x04 1 2 1 7" \
{{0001-01-01 00:00:00Z} {0001-01-01 00:00:00Z}\
{0001-01-01 00:00:00Z} {0001-01-01 00:00:00Z}\
{0001-01-01 00:00:00Z} {0001-01-01 00:00:00Z}\
{2016-06-19 19:50:04.1234567Z} {0001-01-01\
00:00:00Z}} \
{0 0 1 1.2 0 0 0 0} \
{0 0 1 1.2 0 0 0 0} \
{0 0 1 1.2 0 0 0 0} \
{00000000-0000-0000-0000-000000000000\
00000000-0000-0000-0000-000000000000\
00000000-0000-0000-0000-000000000000\
00000000-0000-0000-0000-000000000000\
00000000-0000-0000-0000-000000000000\
00060504-0000-0000-0000-000000000000\
00000000-0000-0000-0000-000000000000\
74f1f402-ddef-4027-a78f-3847fa97b830} \
{0 0 1 0 0 0 0 0} \
{0 0 1 0 0 0 0 0} \
{0 0 1 0 0 0 0 0} \
"none none none none three \x04\x05\x06\
{2016-06-19 19:50:04.1234567}\
74f1f402-ddef-4027-a78f-3847fa97b830" \
{{} 0 1 1.2 three {4 5 6} {2016-06-19\
19:50:04.1234567}\
74f1f402-ddef-4027-a78f-3847fa97b830} \
{System.Data.SQLite.SQLiteBlob System.Data.SQLite.SQLiteBlob\
System.Data.SQLite.SQLiteBlob System.Data.SQLite.SQLiteBlob\
System.Data.SQLite.SQLiteBlob System.Data.SQLite.SQLiteBlob\
System.Data.SQLite.SQLiteBlob System.Data.SQLite.SQLiteBlob}]
###############################################################################
set savedDateTimeFormat [object invoke Interpreter.GetActive DateTimeFormat]
if {![isObjectHandle $savedDateTimeFormat]} then {set savedDateTimeFormat null}
object invoke Interpreter.GetActive DateTimeFormat [getDateTimeFormat]
set savedDateTimeKind [object invoke Interpreter.GetActive DateTimeKind]
object invoke Interpreter.GetActive DateTimeKind Utc
###############################################################################
for {set i 0} {$i < [llength $params]} {incr i} {
foreach {
typeName methodName isArray propertyName isRequired value
} [lindex $params $i] break
set typeName [string map [list SDS. System.Data.SQLite.] $typeName]
set expectedResult [lindex $expectedResults $i]
#############################################################################
proc readValueCallback2 $readArgs [subst {
if {$isArray} then {
if {\[catch {
set dataOffset \[\$eventArgs ExtraEventArgs.DataOffset\]
set buffer \[\$eventArgs -create [appendArgs ExtraEventArgs. \
$typeName Buffer]\]
set bufferOffset \[\$eventArgs ExtraEventArgs.BufferOffset\]
set length \[\$eventArgs ExtraEventArgs.Length\]
set readValue \[\$dataReader \[\$eventArgs MethodName\] \
\$index \$dataOffset \$buffer \$bufferOffset \$length\]
\$eventArgs \[appendArgs Value. $propertyName\] \$readValue
} error\]} then {
set readValue \[\$dataReader -tostring GetValue \$index\]
if {"$typeName" eq "Char"} then {
set string \[object create -alias String \$readValue\]
set buffer \[\$string -create -alias ToCharArray]
} else {
set buffer \[object invoke -create -alias \
System.Text.Encoding.UTF8 GetBytes \$readValue\]
}
\$eventArgs \[appendArgs Value. $propertyName\] \$buffer
\$eventArgs ExtraEventArgs.Length \[\$buffer Length\]
} else {
set buffer \[\$eventArgs -create [appendArgs ExtraEventArgs. \
$typeName Buffer]\]
\$eventArgs \[appendArgs Value. $propertyName\] \$buffer
}
} else {
if {\[catch {
if {"$typeName" eq "System.Data.SQLite.SQLiteBlob"} then {
set readValue \[object create -flags +NonPublic $typeName \
null null\]
} else {
set readValue \[\$dataReader \[\$eventArgs MethodName\] \$index\]
if {"$typeName" eq "Char"} then {
set readValue \[object invoke -create Char Parse \$readValue\]
}
}
\$eventArgs \[appendArgs Value. $propertyName\] \$readValue
} error\]} then {
\$eventArgs \[appendArgs Value. $propertyName\] {$value}
}
}
upvar 1 \$completeVarName complete
set complete \[object invoke -create System.Boolean Parse True\]
}]
#############################################################################
runTest {test [appendArgs types-2. $i] [appendArgs $methodName " callback"] \
-setup [subst -nocommands {
set typeName {$typeName}
set methodName {$methodName}
set isArray {$isArray}
setupDb [set fileName [appendArgs types-2. $i .db]] "" "" "" \
UseConnectionReadValueCallbacks
}] -body {
sql execute $db {
CREATE TABLE t1(x INTEGER, y SPECIAL);
INSERT INTO t1 (x, y) VALUES(1, NULL);
INSERT INTO t1 (x, y) VALUES(2, 0);
INSERT INTO t1 (x, y) VALUES(3, 1);
INSERT INTO t1 (x, y) VALUES(4, 1.2);
INSERT INTO t1 (x, y) VALUES(5, 'three');
INSERT INTO t1 (x, y) VALUES(6, X'040506');
INSERT INTO t1 (x, y) VALUES(7, '2016-06-19 19:50:04.1234567');
INSERT INTO t1 (x, y) VALUES(8, '74f1f402-ddef-4027-a78f-3847fa97b830');
}
set callback {-callbackflags +Default readValueCallback2}
set connection [getDbConnection]
set result [list]
set typeCallbacks [object invoke -marshalflags +DynamicCallback \
System.Data.SQLite.SQLiteTypeCallbacks Create null $callback \
null null]
$connection SetTypeCallbacks SPECIAL $typeCallbacks
set dataReader [sql execute -execute reader -format datareader \
-alias $db "SELECT y FROM t1 ORDER BY x;"]
while {[$dataReader Read]} {
if {$isArray} then {
set buffer [object invoke \
-create Array CreateInstance $typeName 100]
if {[catch {
$dataReader $methodName 0 0 $buffer 0 1
} value] == 0} then {
lappend result $value
if {$value > 0} then {
set list [object create -alias StringList $buffer]
lappend result [object invoke StringList GetRange \
$list 0 [expr {$value - 1}] false]
}
} else {
lappend result [list error(array) $::errorCode]
}
} else {
if {[catch {
if {$typeName eq "System.Data.SQLite.SQLiteBlob"} then {
$dataReader $methodName 0 true; # read-only
} else {
$dataReader $methodName 0
}
} value] == 0} then {
if {[string length $value] == 0} then {
lappend result <EMPTY>
} elseif {$value eq "\x00"} then {
lappend result <NUL>
} else {
lappend result [getStringFromObjectHandle $value]
}
} else {
lappend result [list error(value) $::errorCode]
}
}
}
set result
} -cleanup {
catch {object removecallback $callback}
unset -nocomplain dataReader
freeDbConnection
cleanupDb $fileName
unset -nocomplain buffer typeCallbacks callback value list
unset -nocomplain result connection db fileName
unset -nocomplain typeName methodName isArray
} -constraints {eagle command.object monoBug28 command.sql compile.DATA\
compile.EMIT SQLite System.Data.SQLite} -result $expectedResult}
rename readValueCallback2 ""
}
###############################################################################
object invoke Interpreter.GetActive DateTimeFormat $savedDateTimeFormat
unset -nocomplain savedDateTimeFormat
object invoke Interpreter.GetActive DateTimeKind $savedDateTimeKind
unset -nocomplain savedDateTimeKind
###############################################################################
unset -nocomplain i readArgs params typeName methodName isArray propertyName \
isRequired value expectedResults expectedResult
###############################################################################
runTest {test types-3.1 {bind callback (incomplete)} -setup {
unset -nocomplain log
setupDb [set fileName types-3.1.db] "" "" "" \
"UseConnectionBindValueCallbacks UseParameterNameForTypeName"
} -body {
sql execute $db {
CREATE TABLE t1(x SPECIAL);
}
set callback {-callbackflags +Default bindValueCallback1}
set connection [getDbConnection]
set typeCallbacks [object invoke -marshalflags +DynamicCallback \
System.Data.SQLite.SQLiteTypeCallbacks Create $callback null \
0 null]
$connection SetTypeCallbacks SPECIAL $typeCallbacks
sql execute $db {
INSERT INTO t1 (x) VALUES(?);
} [list Special Int64 1234]
set result [list]
lappend result [expr {
[info exists log(bind)] ? $log(bind) : "<MISSING>"
}]
lappend result [sql execute -execute reader -format list $db \
"SELECT * FROM t1 ORDER BY x;"]
set result
} -cleanup {
catch {object removecallback $callback}
freeDbConnection
cleanupDb $fileName
unset -nocomplain result typeCallbacks callback log connection db fileName
} -constraints {eagle command.object monoBug28 command.sql compile.DATA\
compile.EMIT SQLite System.Data.SQLite} -result {{{convert true} {command true}\
{flags {UseConnectionBindValueCallbacks, UseParameterNameForTypeName}}\
{parameter true} {typeName Special} {index 1} {userData 0}} 1234}}
###############################################################################
runTest {test types-3.2 {bind callback (complete)} -setup {
unset -nocomplain log
setupDb [set fileName types-3.2.db] "" "" "" \
"UseConnectionBindValueCallbacks UseParameterNameForTypeName"
} -body {
sql execute $db {
CREATE TABLE t1(x SPECIAL);
}
set callback {-callbackflags +Default bindValueCallback1}
set connection [getDbConnection]
set typeCallbacks [object invoke -marshalflags +DynamicCallback \
System.Data.SQLite.SQLiteTypeCallbacks Create $callback null \
1 null]
$connection SetTypeCallbacks SPECIAL $typeCallbacks
sql execute $db {
INSERT INTO t1 (x) VALUES(?);
} [list Special Int64 5678]
set result [list]
lappend result [expr {
[info exists log(bind)] ? $log(bind) : "<MISSING>"
}]
lappend result [sql execute -execute reader -format list $db \
"SELECT * FROM t1 ORDER BY x;"]
set result
} -cleanup {
catch {object removecallback $callback}
freeDbConnection
cleanupDb $fileName
unset -nocomplain result typeCallbacks callback log connection db fileName
} -constraints {eagle command.object monoBug28 command.sql compile.DATA\
compile.EMIT SQLite System.Data.SQLite} -result {{{convert true} {command true}\
{flags {UseConnectionBindValueCallbacks, UseParameterNameForTypeName}}\
{parameter true} {typeName Special} {index 1} {userData 1}} {}}}
###############################################################################
runTest {test types-3.3 {bind callback (modify/incomplete)} -setup {
unset -nocomplain log
setupDb [set fileName types-3.3.db] "" "" "" \
"UseConnectionBindValueCallbacks UseParameterNameForTypeName"
} -body {
sql execute $db {
CREATE TABLE t1(x SPECIAL);
}
set callback {-callbackflags +Default bindValueCallback1}
set connection [getDbConnection]
set typeCallbacks [object invoke -marshalflags +DynamicCallback \
System.Data.SQLite.SQLiteTypeCallbacks Create $callback null \
2 null]
$connection SetTypeCallbacks SPECIAL $typeCallbacks
sql execute $db {
INSERT INTO t1 (x) VALUES(?);
} [list Special Int64 9999]
set result [list]
lappend result [expr {
[info exists log(bind)] ? $log(bind) : "<MISSING>"
}]
lappend result [sql execute -execute reader -format list $db \
"SELECT * FROM t1 ORDER BY x;"]
set result
} -cleanup {
catch {object removecallback $callback}
freeDbConnection
cleanupDb $fileName
unset -nocomplain result typeCallbacks callback log connection db fileName
} -constraints {eagle command.object monoBug28 command.sql compile.DATA\
compile.EMIT SQLite System.Data.SQLite} -result {{{convert true} {command true}\
{flags {UseConnectionBindValueCallbacks, UseParameterNameForTypeName}}\
{parameter true} {typeName Special} {index 1} {userData 2}} custom}}
###############################################################################
runTest {test types-4.1 {read callback (exception)} -setup {
unset -nocomplain log
setupDb [set fileName types-4.1.db] "" "" "" \
UseConnectionReadValueCallbacks
} -body {
sql execute $db {
CREATE TABLE t1(x SPECIAL);
INSERT INTO t1 (x) VALUES(8888);
}
set callback {-callbackflags {+Default ThrowOnError} readValueCallback1}
set connection [getDbConnection]
set typeCallbacks [object invoke -marshalflags +DynamicCallback \
System.Data.SQLite.SQLiteTypeCallbacks Create null $callback \
null 3]
$connection SetTypeCallbacks SPECIAL $typeCallbacks
set result [list]
lappend result [catch {
sql execute -execute reader -format list $db {SELECT * FROM t1 ORDER BY x;}
} error]
lappend result [extractSystemDataSQLiteExceptionMessage $error]
lappend result [catch {
sql execute -execute scalar $db {SELECT COUNT(*) FROM t1;}
} error]
lappend result [extractSystemDataSQLiteExceptionMessage $error]
lappend result [expr {[info exists log(read)] ? $log(read) : "<MISSING>"}]
set result
} -cleanup {
catch {object removecallback $callback}
freeDbConnection
cleanupDb $fileName
unset -nocomplain error result typeCallbacks callback log connection db \
fileName
} -constraints {eagle command.object monoBug28 command.sql compile.DATA\
compile.EMIT SQLite System.Data.SQLite} -result {1 {reading of value canceled}\
0 1 {{convert true} {dataReader true} {flags UseConnectionReadValueCallbacks}\
{eventArgs true} {typeName SPECIAL} {index 0} {userData 3}}}}
###############################################################################
runTest {test types-5.1 {bind callback (exception)} -setup {
unset -nocomplain log
setupDb [set fileName types-5.1.db] "" "" "" \
"UseConnectionBindValueCallbacks UseParameterNameForTypeName"
} -body {
sql execute $db {
CREATE TABLE t1(x SPECIAL);
}
set callback {-callbackflags {+Default ThrowOnError} bindValueCallback1}
set connection [getDbConnection]
set typeCallbacks [object invoke -marshalflags +DynamicCallback \
System.Data.SQLite.SQLiteTypeCallbacks Create $callback null \
3 null]
$connection SetTypeCallbacks SPECIAL $typeCallbacks
catch {
sql execute $db {
INSERT INTO t1 (x) VALUES(?);
} [list Special Int64 4321]
}
set result [list]
lappend result [expr {
[info exists log(bind)] ? $log(bind) : "<MISSING>"
}]
lappend result [sql execute -execute reader -format list $db \
"SELECT * FROM t1 ORDER BY x;"]
set result
} -cleanup {
catch {object removecallback $callback}
freeDbConnection
cleanupDb $fileName
unset -nocomplain result typeCallbacks callback log connection db fileName
} -constraints {eagle command.object monoBug28 command.sql compile.DATA\
compile.EMIT SQLite System.Data.SQLite} -result {{{convert true} {command true}\
{flags {UseConnectionBindValueCallbacks, UseParameterNameForTypeName}}\
{parameter true} {typeName Special} {index 1} {userData 3}} {}}}
###############################################################################
catch {eval object dispose [info objects System#Boolean#*]}
###############################################################################
rename readValueCallback1 ""
rename bindValueCallback1 ""
###############################################################################
runSQLiteTestEpilogue
runTestEpilogue
