limbo/testing/tester.tcl
Ihor Andrianov 3a97fd075f
add tests
2025-04-07 20:02:14 +03:00

210 lines
8.6 KiB
Tcl
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

set sqlite_exec [expr {[info exists env(SQLITE_EXEC)] ? $env(SQLITE_EXEC) : "sqlite3"}]
set test_dbs [list "testing/testing.db" "testing/testing_norowidalias.db"]
set test_small_dbs [list "testing/testing_small.db" ]
proc evaluate_sql {sqlite_exec db_name sql} {
set command [list $sqlite_exec $db_name $sql]
set output [exec {*}$command]
return $output
}
proc run_test {sqlite_exec db_name sql expected_output} {
set actual_output [evaluate_sql $sqlite_exec $db_name $sql]
if {$actual_output ne $expected_output} {
puts "Test FAILED: '$sql'"
puts "returned '$actual_output'"
puts "expected '$expected_output'"
exit 1
}
}
proc do_execsql_test {test_name sql_statements expected_outputs} {
foreach db $::test_dbs {
puts [format "(%s) %s Running test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
set combined_expected_output [join $expected_outputs "\n"]
run_test $::sqlite_exec $db $combined_sql $combined_expected_output
}
}
proc do_execsql_test_small {test_name sql_statements expected_outputs} {
foreach db $::test_small_dbs {
puts [format "(%s) %s Running test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
set combined_expected_output [join $expected_outputs "\n"]
run_test $::sqlite_exec $db $combined_sql $combined_expected_output
}
}
proc do_execsql_test_regex {test_name sql_statements expected_regex} {
foreach db $::test_dbs {
puts [format "(%s) %s Running test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
set actual_output [evaluate_sql $::sqlite_exec $db $combined_sql]
# Validate the actual output against the regular expression
if {![regexp $expected_regex $actual_output]} {
puts "Test FAILED: '$sql_statements'"
puts "returned '$actual_output'"
puts "expected to match regex '$expected_regex'"
exit 1
}
}
}
proc do_execsql_test_on_specific_db {db_name test_name sql_statements expected_outputs} {
puts [format "(%s) %s Running test: %s" $db_name [string repeat " " [expr {40 - [string length $db_name]}]] $test_name]
set combined_sql [string trim $sql_statements]
set combined_expected_output [join $expected_outputs "\n"]
run_test $::sqlite_exec $db_name $combined_sql $combined_expected_output
}
proc within_tolerance {actual expected tolerance} {
expr {abs($actual - $expected) <= $tolerance}
}
# This function is used to test floating point values within a tolerance
# FIXME: When Limbo's floating point presentation matches to SQLite, this could/should be removed
proc do_execsql_test_tolerance {test_name sql_statements expected_outputs tolerance} {
foreach db $::test_dbs {
puts [format "(%s) %s Running test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
set actual_output [evaluate_sql $::sqlite_exec $db $combined_sql]
set actual_values [split $actual_output "\n"]
set expected_values [split $expected_outputs "\n"]
if {[llength $actual_values] != [llength $expected_values]} {
puts "Test FAILED: '$sql_statements'"
puts "returned '$actual_output'"
puts "expected '$expected_outputs'"
exit 1
}
for {set i 0} {$i < [llength $actual_values]} {incr i} {
set actual [lindex $actual_values $i]
set expected [lindex $expected_values $i]
if {![within_tolerance $actual $expected $tolerance]} {
set lower_bound [expr {$expected - $tolerance}]
set upper_bound [expr {$expected + $tolerance}]
puts "Test FAILED: '$sql_statements'"
puts "returned '$actual'"
puts "expected a value within the range \[$lower_bound, $upper_bound\]"
exit 1
}
}
}
}
# This procedure passes the test if the output contains error messages
proc run_test_expecting_any_error {sqlite_exec db_name sql} {
# Execute the SQL command and capture output
set command [list $sqlite_exec $db_name $sql]
# Use catch to handle both successful and error cases
catch {exec {*}$command} result options
# Check if the output contains error indicators (×, error, syntax error, etc.)
if {[regexp {(error|ERROR|Error|×|syntax error|failed)} $result]} {
# Error found in output - test passed
puts "Test PASSED: Got expected error"
return 1
}
# No error indicators in output
puts "Test FAILED: '$sql'"
puts "Expected an error but command output didn't indicate any error: '$result'"
exit 1
}
# This procedure passes if error matches a specific pattern
proc run_test_expecting_error {sqlite_exec db_name sql expected_error_pattern} {
# Execute the SQL command and capture output
set command [list $sqlite_exec $db_name $sql]
# Capture output whether command succeeds or fails
catch {exec {*}$command} result options
# Check if the output contains error indicators first
if {![regexp {(error|ERROR|Error|×|syntax error|failed)} $result]} {
puts "Test FAILED: '$sql'"
puts "Expected an error matching '$expected_error_pattern'"
puts "But command output didn't indicate any error: '$result'"
exit 1
}
# Now check if the error message matches the expected pattern
if {![regexp $expected_error_pattern $result]} {
puts "Test FAILED: '$sql'"
puts "Error occurred but didn't match expected pattern."
puts "Output was: '$result'"
puts "Expected pattern: '$expected_error_pattern'"
exit 1
}
# If we get here, the test passed - got expected error matching pattern
return 1
}
# This version accepts exact error text, ignoring formatting
proc run_test_expecting_error_content {sqlite_exec db_name sql expected_error_text} {
# Execute the SQL command and capture output
set command [list $sqlite_exec $db_name $sql]
# Capture output whether command succeeds or fails
catch {exec {*}$command} result options
# Check if the output contains error indicators first
if {![regexp {(error|ERROR|Error|×|syntax error|failed)} $result]} {
puts "Test FAILED: '$sql'"
puts "Expected an error with text: '$expected_error_text'"
puts "But command output didn't indicate any error: '$result'"
exit 1
}
# Normalize both the actual and expected error messages
# Remove all whitespace, newlines, and special characters for comparison
set normalized_actual [regsub -all {[[:space:]]|[[:punct:]]} $result ""]
set normalized_expected [regsub -all {[[:space:]]|[[:punct:]]} $expected_error_text ""]
# Convert to lowercase for case-insensitive comparison
set normalized_actual [string tolower $normalized_actual]
set normalized_expected [string tolower $normalized_expected]
# Check if the normalized strings contain the same text
if {[string first $normalized_expected $normalized_actual] == -1} {
puts "Test FAILED: '$sql'"
puts "Error occurred but content didn't match."
puts "Output was: '$result'"
puts "Expected text: '$expected_error_text'"
exit 1
}
# If we get here, the test passed - got error with expected content
return 1
}
proc do_execsql_test_error {test_name sql_statements expected_error_pattern} {
foreach db $::test_dbs {
puts [format "(%s) %s Running error test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
run_test_expecting_error $::sqlite_exec $db $combined_sql $expected_error_pattern
}
}
proc do_execsql_test_error_content {test_name sql_statements expected_error_text} {
foreach db $::test_dbs {
puts [format "(%s) %s Running error content test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
run_test_expecting_error_content $::sqlite_exec $db $combined_sql $expected_error_text
}
}
proc do_execsql_test_any_error {test_name sql_statements} {
foreach db $::test_dbs {
puts [format "(%s) %s Running any-error test: %s" $db [string repeat " " [expr {40 - [string length $db]}]] $test_name]
set combined_sql [string trim $sql_statements]
run_test_expecting_any_error $::sqlite_exec $db $combined_sql
}
}