mirror of
https://github.com/tursodatabase/limbo.git
synced 2025-08-06 11:08:02 +00:00
639 lines
No EOL
20 KiB
Tcl
639 lines
No EOL
20 KiB
Tcl
# SQLite Test Framework - Simplified Version
|
||
# Based on the official SQLite tester.tcl
|
||
|
||
# Global variables for test execution (safe to re-initialize)
|
||
if {![info exists TC(errors)]} {
|
||
set TC(errors) 0
|
||
}
|
||
if {![info exists TC(count)]} {
|
||
set TC(count) 0
|
||
}
|
||
if {![info exists TC(fail_list)]} {
|
||
set TC(fail_list) [list]
|
||
}
|
||
if {![info exists testprefix]} {
|
||
set testprefix ""
|
||
}
|
||
|
||
# Path to our SQLite-compatible executable
|
||
# Use absolute path to avoid issues with different working directories
|
||
set script_dir [file dirname [file dirname [file dirname [file normalize [info script]]]]]
|
||
set limbo_sqlite3 [file join $script_dir "scripts" "limbo-sqlite3"]
|
||
set test_db "test.db"
|
||
|
||
# Database connection state
|
||
set db_handle ""
|
||
set session_sql_file "session_[pid].sql"
|
||
set session_initialized 0
|
||
|
||
# Create or reset test database
|
||
proc reset_db {} {
|
||
global test_db limbo_sqlite3
|
||
file delete -force $test_db
|
||
file delete -force "${test_db}-journal"
|
||
file delete -force "${test_db}-wal"
|
||
|
||
# Initialize the database by creating a simple table and dropping it
|
||
# This ensures the database file exists and has proper headers
|
||
catch {
|
||
set temp_file "init_db_[pid].sql"
|
||
set fd [open $temp_file w]
|
||
puts $fd "CREATE TABLE IF NOT EXISTS _init_table(x); DROP TABLE IF EXISTS _init_table;"
|
||
close $fd
|
||
exec $limbo_sqlite3 $test_db < $temp_file 2>/dev/null
|
||
file delete -force $temp_file
|
||
}
|
||
|
||
# Create the database connection using our sqlite3 command simulation
|
||
sqlite3 db $test_db
|
||
}
|
||
|
||
# Open database connection (simulate TCL sqlite3 interface)
|
||
proc db_open {} {
|
||
global test_db db_handle
|
||
set db_handle "db"
|
||
# Database is opened on first use
|
||
}
|
||
|
||
# Execute SQL using external process
|
||
proc exec_sql {sql {db_name ""}} {
|
||
global limbo_sqlite3 test_db
|
||
|
||
if {$db_name eq ""} {
|
||
set db_name $test_db
|
||
}
|
||
|
||
# Split multi-statement SQL into individual statements
|
||
# This is a simple split on semicolon - not perfect but works for most cases
|
||
set statements [list]
|
||
set current_stmt ""
|
||
set in_string 0
|
||
set string_char ""
|
||
|
||
for {set i 0} {$i < [string length $sql]} {incr i} {
|
||
set char [string index $sql $i]
|
||
|
||
if {!$in_string} {
|
||
if {$char eq "'" || $char eq "\""} {
|
||
set in_string 1
|
||
set string_char $char
|
||
} elseif {$char eq ";"} {
|
||
# End of statement
|
||
set stmt [string trim $current_stmt]
|
||
if {$stmt ne ""} {
|
||
lappend statements $stmt
|
||
}
|
||
set current_stmt ""
|
||
continue
|
||
}
|
||
} else {
|
||
if {$char eq $string_char} {
|
||
# Check for escaped quotes
|
||
if {$i > 0 && [string index $sql [expr {$i-1}]] ne "\\"} {
|
||
set in_string 0
|
||
}
|
||
}
|
||
}
|
||
|
||
append current_stmt $char
|
||
}
|
||
|
||
# Add the last statement if any
|
||
set stmt [string trim $current_stmt]
|
||
if {$stmt ne ""} {
|
||
lappend statements $stmt
|
||
}
|
||
|
||
# If no statements found, treat the whole SQL as one statement
|
||
if {[llength $statements] == 0} {
|
||
set statements [list [string trim $sql]]
|
||
}
|
||
|
||
# Execute each statement separately and collect results
|
||
set all_output ""
|
||
foreach statement $statements {
|
||
if {[string trim $statement] eq ""} continue
|
||
|
||
if {[catch {exec echo $statement | $limbo_sqlite3 $db_name 2>&1} output errcode]} {
|
||
# Command failed - this might be an error or just stderr output
|
||
|
||
# Handle process crashes more gracefully
|
||
if {[string match "*child process exited abnormally*" $output] ||
|
||
[string match "*CHILDKILLED*" $errcode] ||
|
||
[string match "*CHILDSUSP*" $errcode]} {
|
||
# Process crashed - if this is a single statement, throw error for catchsql
|
||
# If multiple statements, just warn and continue
|
||
if {[llength $statements] == 1} {
|
||
# Try to provide a more specific error message based on common patterns
|
||
set error_msg "limbo-sqlite3 crashed executing: $statement"
|
||
|
||
# Check for IN subquery with multiple columns
|
||
if {[string match -nocase "*IN (SELECT*" $statement]} {
|
||
# Look for comma in SELECT list or SELECT * from multi-column table
|
||
if {[regexp -nocase {IN\s*\(\s*SELECT\s+[^)]*,} $statement] ||
|
||
[regexp -nocase {IN\s*\(\s*SELECT\s+\*\s+FROM} $statement]} {
|
||
set error_msg "sub-select returns 2 columns - expected 1"
|
||
}
|
||
}
|
||
|
||
error $error_msg
|
||
} else {
|
||
puts "Warning: limbo-sqlite3 crashed executing: $statement"
|
||
continue
|
||
}
|
||
}
|
||
|
||
# Special handling for unsupported PRAGMA commands - silently ignore them
|
||
if {[string match -nocase "*PRAGMA*" $statement] && [string match "*Not a valid pragma name*" $output]} {
|
||
continue
|
||
}
|
||
|
||
# Special handling for CREATE TABLE panics - convert to a more user-friendly error
|
||
if {[string match "*CREATE TABLE*" $statement] && [string match "*panicked*" $output]} {
|
||
error "CREATE TABLE not fully supported yet in Limbo"
|
||
}
|
||
|
||
# Check if the output contains error indicators
|
||
if {[string match "*× Parse error*" $output] ||
|
||
[string match "*error*" [string tolower $output]] ||
|
||
[string match "*failed*" [string tolower $output]] ||
|
||
[string match "*panicked*" $output]} {
|
||
# Clean up the error message before throwing
|
||
set clean_error $output
|
||
set clean_error [string trim $clean_error]
|
||
if {[string match "*× Parse error:*" $clean_error]} {
|
||
regsub {\s*×\s*Parse error:\s*} $clean_error {} clean_error
|
||
}
|
||
if {[string match "*Table * not found*" $clean_error]} {
|
||
regsub {Table ([^ ]+) not found.*} $clean_error {no such table: \1} clean_error
|
||
}
|
||
|
||
# Be more forgiving with "no such table" errors for DROP operations and common cleanup
|
||
if {([string match -nocase "*DROP TABLE*" $statement] ||
|
||
[string match -nocase "*DROP INDEX*" $statement]) &&
|
||
([string match "*no such table*" [string tolower $clean_error]] ||
|
||
[string match "*no such index*" [string tolower $clean_error]] ||
|
||
[string match "*table * not found*" [string tolower $clean_error]])} {
|
||
# DROP operation on non-existent object - just continue silently
|
||
continue
|
||
}
|
||
|
||
error $clean_error
|
||
}
|
||
append all_output $output
|
||
} else {
|
||
# Command succeeded
|
||
|
||
# But check if the output still contains unsupported PRAGMA errors
|
||
if {[string match -nocase "*PRAGMA*" $statement] && [string match "*Not a valid pragma name*" $output]} {
|
||
continue
|
||
}
|
||
|
||
# But check if the output still contains error indicators
|
||
if {[string match "*× Parse error*" $output] ||
|
||
[string match "*panicked*" $output]} {
|
||
# Clean up the error message before throwing
|
||
set clean_error $output
|
||
set clean_error [string trim $clean_error]
|
||
if {[string match "*× Parse error:*" $clean_error]} {
|
||
regsub {\s*×\s*Parse error:\s*} $clean_error {} clean_error
|
||
}
|
||
if {[string match "*Table * not found*" $clean_error]} {
|
||
regsub {Table ([^ ]+) not found.*} $clean_error {no such table: \1} clean_error
|
||
}
|
||
|
||
# Be more forgiving with "no such table" errors for DROP operations and common cleanup
|
||
if {([string match -nocase "*DROP TABLE*" $statement] ||
|
||
[string match -nocase "*DROP INDEX*" $statement]) &&
|
||
([string match "*no such table*" [string tolower $clean_error]] ||
|
||
[string match "*no such index*" [string tolower $clean_error]] ||
|
||
[string match "*table * not found*" [string tolower $clean_error]])} {
|
||
# DROP operation on non-existent object - just continue silently
|
||
continue
|
||
}
|
||
|
||
error $clean_error
|
||
}
|
||
append all_output $output
|
||
}
|
||
}
|
||
|
||
return $all_output
|
||
}
|
||
|
||
# Simulate sqlite3 db eval interface
|
||
proc sqlite3 {handle db_file} {
|
||
global db_handle test_db
|
||
set db_handle $handle
|
||
set test_db $db_file
|
||
|
||
# Create the eval procedure for this handle
|
||
proc ${handle} {cmd args} {
|
||
switch $cmd {
|
||
"eval" {
|
||
set sql [lindex $args 0]
|
||
|
||
# Check if we have array variable and script arguments
|
||
if {[llength $args] >= 3} {
|
||
set array_var [lindex $args 1]
|
||
set script [lindex $args 2]
|
||
|
||
# Get output with headers to know column names
|
||
global limbo_sqlite3 test_db
|
||
if {[catch {exec echo ".mode list\n.headers on\n$sql" | $limbo_sqlite3 $test_db 2>/dev/null} output]} {
|
||
# Fall back to basic execution
|
||
set output [exec_sql $sql]
|
||
set lines [split $output "\n"]
|
||
set result [list]
|
||
foreach line $lines {
|
||
if {$line ne ""} {
|
||
set fields [split $line "|"]
|
||
foreach field $fields {
|
||
set field [string trim $field]
|
||
# Always append the field, even if empty (represents NULL)
|
||
lappend result $field
|
||
}
|
||
}
|
||
}
|
||
return $result
|
||
}
|
||
|
||
set lines [split $output "\n"]
|
||
set columns [list]
|
||
set data_started 0
|
||
|
||
foreach line $lines {
|
||
set line [string trim $line]
|
||
if {$line eq ""} continue
|
||
|
||
# Skip Turso startup messages
|
||
if {[string match "*Turso*" $line] ||
|
||
[string match "*Enter*" $line] ||
|
||
[string match "*Connected*" $line] ||
|
||
[string match "*Use*" $line] ||
|
||
[string match "*software*" $line]} {
|
||
continue
|
||
}
|
||
|
||
if {!$data_started} {
|
||
# First non-message line should be column headers
|
||
set columns [split $line "|"]
|
||
set trimmed_columns [list]
|
||
foreach col $columns {
|
||
lappend trimmed_columns [string trim $col]
|
||
}
|
||
set columns $trimmed_columns
|
||
set data_started 1
|
||
|
||
# Create the array variable in the caller's scope and set column list
|
||
upvar 1 $array_var data_array
|
||
catch {unset data_array}
|
||
set data_array(*) $columns
|
||
} else {
|
||
# Data row - populate array and execute script
|
||
set values [split $line "|"]
|
||
set trimmed_values [list]
|
||
foreach val $values {
|
||
lappend trimmed_values [string trim $val]
|
||
}
|
||
set values $trimmed_values
|
||
|
||
# Populate the array variable
|
||
upvar 1 $array_var data_array
|
||
set proc_name [lindex [info level 0] 0]
|
||
global ${proc_name}_null_value
|
||
for {set i 0} {$i < [llength $columns] && $i < [llength $values]} {incr i} {
|
||
set value [lindex $values $i]
|
||
# Replace empty values with null representation if set
|
||
if {$value eq "" && [info exists ${proc_name}_null_value]} {
|
||
set value [set ${proc_name}_null_value]
|
||
}
|
||
set data_array([lindex $columns $i]) $value
|
||
}
|
||
|
||
# Execute the script in the caller's context
|
||
uplevel 1 $script
|
||
}
|
||
}
|
||
|
||
return ""
|
||
} else {
|
||
# Original simple case
|
||
set output [exec_sql $sql]
|
||
# Convert output to list format
|
||
set lines [split $output "\n"]
|
||
set result [list]
|
||
set proc_name [lindex [info level 0] 0]
|
||
global ${proc_name}_null_value
|
||
foreach line $lines {
|
||
if {$line ne ""} {
|
||
# Split by pipe separator
|
||
set fields [split $line "|"]
|
||
foreach field $fields {
|
||
set field [string trim $field]
|
||
# Handle null representation for empty fields
|
||
if {$field eq "" && [info exists ${proc_name}_null_value]} {
|
||
set field [set ${proc_name}_null_value]
|
||
}
|
||
lappend result $field
|
||
}
|
||
}
|
||
}
|
||
return $result
|
||
}
|
||
}
|
||
"one" {
|
||
set sql [lindex $args 0]
|
||
set output [exec_sql $sql]
|
||
# Convert output and return only the first value
|
||
set lines [split $output "\n"]
|
||
set proc_name [lindex [info level 0] 0]
|
||
global ${proc_name}_null_value
|
||
foreach line $lines {
|
||
set line [string trim $line]
|
||
if {$line ne ""} {
|
||
# Split by pipe separator and return first field
|
||
set fields [split $line "|"]
|
||
set first_field [string trim [lindex $fields 0]]
|
||
# Handle null representation
|
||
if {$first_field eq "" && [info exists ${proc_name}_null_value]} {
|
||
set first_field [set ${proc_name}_null_value]
|
||
}
|
||
return $first_field
|
||
}
|
||
}
|
||
# Return empty string if no results, or null representation if set
|
||
if {[info exists ${proc_name}_null_value]} {
|
||
return [set ${proc_name}_null_value]
|
||
}
|
||
return ""
|
||
}
|
||
"close" {
|
||
# Nothing special needed for external process
|
||
return
|
||
}
|
||
"null" {
|
||
# Set the null value representation
|
||
# In SQLite TCL interface, this sets what string to use for NULL values
|
||
# For our simplified implementation, we'll store it globally
|
||
# Use the procedure name (which is the handle name) to construct variable name
|
||
set proc_name [lindex [info level 0] 0]
|
||
global ${proc_name}_null_value
|
||
if {[llength $args] > 0} {
|
||
set ${proc_name}_null_value [lindex $args 0]
|
||
} else {
|
||
set ${proc_name}_null_value ""
|
||
}
|
||
return ""
|
||
}
|
||
default {
|
||
error "Unknown db command: $cmd"
|
||
}
|
||
}
|
||
}
|
||
}
|
||
|
||
# Execute SQL and return results
|
||
proc execsql {sql {db db}} {
|
||
# For our external approach, ignore the db parameter
|
||
set output [exec_sql $sql]
|
||
|
||
# Convert output to TCL list format
|
||
set lines [split $output "\n"]
|
||
set result [list]
|
||
foreach line $lines {
|
||
if {$line ne ""} {
|
||
# Split by pipe separator
|
||
set fields [split $line "|"]
|
||
foreach field $fields {
|
||
set field [string trim $field]
|
||
# Always append the field, even if empty (represents NULL)
|
||
lappend result $field
|
||
}
|
||
}
|
||
}
|
||
return $result
|
||
}
|
||
|
||
# Execute SQL and return first value only (similar to db one)
|
||
proc db_one {sql {db db}} {
|
||
set result [execsql $sql $db]
|
||
if {[llength $result] > 0} {
|
||
return [lindex $result 0]
|
||
} else {
|
||
return ""
|
||
}
|
||
}
|
||
|
||
# Execute SQL and return results with column names
|
||
# Format: column1 value1 column2 value2 ... (alternating for each row)
|
||
proc execsql2 {sql {db db}} {
|
||
global limbo_sqlite3 test_db
|
||
|
||
# Use .headers on to get column names from the CLI
|
||
if {[catch {exec echo ".mode list\n.headers on\n$sql" | $limbo_sqlite3 $test_db 2>/dev/null} output]} {
|
||
# Fall back to execsql if there's an error
|
||
return [execsql $sql $db]
|
||
}
|
||
|
||
set lines [split $output "\n"]
|
||
set result [list]
|
||
set columns [list]
|
||
set data_started 0
|
||
|
||
foreach line $lines {
|
||
set line [string trim $line]
|
||
if {$line eq ""} continue
|
||
|
||
# Skip Turso startup messages
|
||
if {[string match "*Turso*" $line] ||
|
||
[string match "*Enter*" $line] ||
|
||
[string match "*Connected*" $line] ||
|
||
[string match "*Use*" $line] ||
|
||
[string match "*software*" $line]} {
|
||
continue
|
||
}
|
||
|
||
if {!$data_started} {
|
||
# First non-message line should be column headers
|
||
set columns [split $line "|"]
|
||
set trimmed_columns [list]
|
||
foreach col $columns {
|
||
lappend trimmed_columns [string trim $col]
|
||
}
|
||
set columns $trimmed_columns
|
||
set data_started 1
|
||
} else {
|
||
# Data row
|
||
set values [split $line "|"]
|
||
set trimmed_values [list]
|
||
foreach val $values {
|
||
lappend trimmed_values [string trim $val]
|
||
}
|
||
set values $trimmed_values
|
||
|
||
# Add column-value pairs for this row
|
||
for {set i 0} {$i < [llength $columns] && $i < [llength $values]} {incr i} {
|
||
lappend result [lindex $columns $i] [lindex $values $i]
|
||
}
|
||
}
|
||
}
|
||
|
||
return $result
|
||
}
|
||
|
||
# Execute SQL and catch errors
|
||
proc catchsql {sql {db db}} {
|
||
if {[catch {execsql $sql $db} result]} {
|
||
# Clean up the error message - remove the × Parse error: prefix if present
|
||
set cleaned_msg $result
|
||
|
||
# First trim whitespace/newlines
|
||
set cleaned_msg [string trim $cleaned_msg]
|
||
|
||
# Remove the "× Parse error: " prefix (including any leading whitespace)
|
||
if {[string match "*× Parse error:*" $cleaned_msg]} {
|
||
regsub {\s*×\s*Parse error:\s*} $cleaned_msg {} cleaned_msg
|
||
}
|
||
|
||
# Convert some common Limbo error messages to SQLite format
|
||
if {[string match "*Table * not found*" $cleaned_msg]} {
|
||
regsub {Table ([^ ]+) not found.*} $cleaned_msg {no such table: \1} cleaned_msg
|
||
}
|
||
|
||
return [list 1 $cleaned_msg]
|
||
} else {
|
||
return [list 0 $result]
|
||
}
|
||
}
|
||
|
||
# Main test execution function
|
||
proc do_test {name cmd expected} {
|
||
global TC testprefix
|
||
|
||
# Add prefix if it exists
|
||
if {$testprefix ne ""} {
|
||
set name "${testprefix}-$name"
|
||
}
|
||
|
||
incr TC(count)
|
||
puts -nonewline "$name... "
|
||
flush stdout
|
||
|
||
if {[catch {uplevel #0 $cmd} result]} {
|
||
puts "ERROR: $result"
|
||
lappend TC(fail_list) $name
|
||
incr TC(errors)
|
||
return
|
||
}
|
||
|
||
# Compare result with expected
|
||
set ok 0
|
||
if {[regexp {^/.*/$} $expected]} {
|
||
# Regular expression match
|
||
set pattern [string range $expected 1 end-1]
|
||
set ok [regexp $pattern $result]
|
||
} elseif {[string match "*" $expected]} {
|
||
# Glob pattern match
|
||
set ok [string match $expected $result]
|
||
} else {
|
||
# Exact match - handle both list and string formats
|
||
if {[llength $expected] > 1 || [llength $result] > 1} {
|
||
# List comparison
|
||
set ok [expr {$result eq $expected}]
|
||
} else {
|
||
# String comparison
|
||
set ok [expr {[string trim $result] eq [string trim $expected]}]
|
||
}
|
||
}
|
||
|
||
if {$ok} {
|
||
puts "Ok"
|
||
} else {
|
||
puts "FAILED"
|
||
puts " Expected: $expected"
|
||
puts " Got: $result"
|
||
lappend TC(fail_list) $name
|
||
incr TC(errors)
|
||
}
|
||
}
|
||
|
||
# Execute SQL test with expected results
|
||
proc do_execsql_test {name sql {expected {}}} {
|
||
do_test $name [list execsql $sql] $expected
|
||
}
|
||
|
||
# Execute SQL test expecting an error
|
||
proc do_catchsql_test {name sql expected} {
|
||
do_test $name [list catchsql $sql] $expected
|
||
}
|
||
|
||
# Placeholder for virtual table conditional tests
|
||
proc do_execsql_test_if_vtab {name sql expected} {
|
||
# For now, just run the test (assume vtab support)
|
||
do_execsql_test $name $sql $expected
|
||
}
|
||
|
||
# Database integrity check
|
||
proc integrity_check {name} {
|
||
do_execsql_test $name {PRAGMA integrity_check} {ok}
|
||
}
|
||
|
||
# Query execution plan test (simplified)
|
||
proc do_eqp_test {name sql expected} {
|
||
do_execsql_test $name "EXPLAIN QUERY PLAN $sql" $expected
|
||
}
|
||
|
||
# Capability checking (simplified - assume all features available)
|
||
proc ifcapable {expr code {else ""} {elsecode ""}} {
|
||
# For simplicity, always execute the main code
|
||
# In a full implementation, this would check SQLite compile options
|
||
uplevel 1 $code
|
||
}
|
||
|
||
# Capability test (simplified)
|
||
proc capable {expr} {
|
||
# For simplicity, assume all capabilities are available
|
||
return 1
|
||
}
|
||
|
||
# Sanitizer detection (simplified - assume no sanitizers)
|
||
proc clang_sanitize_address {} {
|
||
return 0
|
||
}
|
||
|
||
# SQLite configuration constants (set to reasonable defaults)
|
||
# These are typically set based on compile-time options
|
||
set SQLITE_MAX_COMPOUND_SELECT 500
|
||
set SQLITE_MAX_VDBE_OP 25000
|
||
set SQLITE_MAX_FUNCTION_ARG 127
|
||
set SQLITE_MAX_ATTACHED 10
|
||
set SQLITE_MAX_VARIABLE_NUMBER 999
|
||
set SQLITE_MAX_COLUMN 2000
|
||
set SQLITE_MAX_SQL_LENGTH 1000000
|
||
set SQLITE_MAX_EXPR_DEPTH 1000
|
||
set SQLITE_MAX_LIKE_PATTERN_LENGTH 50000
|
||
set SQLITE_MAX_TRIGGER_DEPTH 1000
|
||
|
||
# Finish test execution and report results
|
||
proc finish_test {} {
|
||
global TC
|
||
|
||
# Check if we're running as part of all.test - if so, don't exit
|
||
if {[info exists ::ALL_TESTS]} {
|
||
# Running as part of all.test - just return without exiting
|
||
return
|
||
}
|
||
|
||
puts ""
|
||
puts "=========================================="
|
||
if {$TC(errors) == 0} {
|
||
puts "All $TC(count) tests passed!"
|
||
} else {
|
||
puts "$TC(errors) errors out of $TC(count) tests"
|
||
puts "Failed tests: $TC(fail_list)"
|
||
}
|
||
puts "=========================================="
|
||
}
|
||
|
||
reset_db |