#!/usr/bin/env tclsh # MIME Module Test Suite # Tests for untested code paths in mime-1.7.1.tm package require Tcl 8.5 package require mime # Test counter set test_count 0 set test_passed 0 set test_failed 0 proc test {name body expected} { global test_count test_passed test_failed incr test_count if {[catch {uplevel 1 $body} result]} { puts "FAIL: $name" puts " Error: $result" incr test_failed return 0 } if {$result eq $expected} { puts "PASS: $name" incr test_passed return 1 } else { puts "FAIL: $name" puts " Expected: $expected" puts " Got: $result" incr test_failed return 0 } } proc test_error {name body error_pattern} { global test_count test_passed test_failed incr test_count if {[catch {uplevel 1 $body} result]} { if {[string match $error_pattern $result]} { puts "PASS: $name (error caught as expected)" incr test_passed return 1 } else { puts "FAIL: $name" puts " Expected error matching: $error_pattern" puts " Got error: $result" incr test_failed return 0 } } else { puts "FAIL: $name (no error raised)" puts " Expected error matching: $error_pattern" puts " Got result: $result" incr test_failed return 0 } } # ============================================================================ # Test 1: mime::finalize with -subordinates all # Tests the untested code path at line 1172 # ============================================================================ puts "\n=== Test Group 1: mime::finalize with -subordinates all ===" test "finalize with -subordinates all (no parts)" { set token [mime::initialize -canonical "text/plain" -string "Hello World"] mime::finalize $token -subordinates all # If we get here without error, test passes expr {1} } 1 test "finalize with -subordinates all (with parts)" { set parent [mime::initialize -canonical "multipart/mixed" -parts [list]] # Finalize with all subordinates mime::finalize $parent -subordinates all expr {1} } 1 # ============================================================================ # Test 2: mime::finalize with -subordinates dynamic # Tests the dynamic subordinates path # ============================================================================ puts "\n=== Test Group 2: mime::finalize with -subordinates dynamic ===" test "finalize with -subordinates dynamic" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::finalize $token -subordinates dynamic expr {1} } 1 # ============================================================================ # Test 3: mime::finalize with -subordinates none # Tests the none subordinates path # ============================================================================ puts "\n=== Test Group 3: mime::finalize with -subordinates none ===" test "finalize with -subordinates none" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::finalize $token -subordinates none expr {1} } 1 # ============================================================================ # Test 4: mime::finalize with invalid -subordinates # Tests error handling # ============================================================================ puts "\n=== Test Group 4: mime::finalize error handling ===" test_error "finalize with invalid -subordinates" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::finalize $token -subordinates invalid } "*unknown value for -subordinates*" # ============================================================================ # Test 5: mime::setheader with new key (untested path at line 1517) # ============================================================================ puts "\n=== Test Group 5: mime::setheader with new key ===" test "setheader adding new header key" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::setheader $token X-Custom-Header "custom value" set result [mime::getheader $token X-Custom-Header] mime::finalize $token expr {[string match "*custom value*" $result]} } 1 test "setheader delete non-existent key error" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [catch {mime::setheader $token X-NonExistent "" -mode delete} err] mime::finalize $token expr {$result == 1} } 1 # ============================================================================ # Test 6: mime::encodingasciiP with non-ASCII text (untested path at line 2187) # ============================================================================ puts "\n=== Test Group 6: mime::encodingasciiP and encoding detection ===" test "encodingasciiP with pure ASCII" { mime::encodingasciiP "Hello World" } 1 test "encodingasciiP with non-ASCII" { mime::encodingasciiP "Héllo Wörld" } 0 test "encodingasciiP with soft newlines" { mime::encodingasciiP "Hello=\nWorld" } 1 # ============================================================================ # Test 7: mime::qp_decode with encoded characters (untested path at line 2455) # ============================================================================ puts "\n=== Test Group 7: mime::qp_decode ===" test "qp_decode with encoded equals" { set encoded "Hello=3DWorld" set result [mime::qp_decode $encoded] string match "*Hello*World*" $result } 1 test "qp_decode with soft newline" { set encoded "Hello=\nWorld" set result [mime::qp_decode $encoded] string match "*HelloWorld*" $result } 1 # ============================================================================ # Test 8: mime::parseaddress basic functionality # ============================================================================ puts "\n=== Test Group 8: mime::parseaddress ===" test "parseaddress simple email" { set result [mime::parseaddress "user@example.com"] llength $result } 1 test "parseaddress with display name" { set result [mime::parseaddress "John Doe "] llength $result } 1 test "parseaddress multiple addresses" { set result [mime::parseaddress "user1@example.com, user2@example.com"] llength $result } 2 test "parseaddress with comment" { set result [mime::parseaddress "user@example.com (comment)"] llength $result } 1 # ============================================================================ # Test 9: mime::copymessage with different value types # ============================================================================ puts "\n=== Test Group 9: mime::copymessage ===" test "copymessage with string content" { set token [mime::initialize -canonical "text/plain" -string "Test content"] set tmpfile [file tempfile] set fd [open $tmpfile w+] mime::copymessage $token $fd close $fd file delete $tmpfile mime::finalize $token expr {1} } 1 # ============================================================================ # Test 10: mime::buildmessage # ============================================================================ puts "\n=== Test Group 10: mime::buildmessage ===" test "buildmessage with string content" { set token [mime::initialize -canonical "text/plain" -string "Test content"] set result [mime::buildmessage $token] mime::finalize $token # buildmessage includes headers, so just check it's not empty expr {[string length $result] > 0} } 1 # ============================================================================ # Test 11: mime::getproperty with various properties # ============================================================================ puts "\n=== Test Group 11: mime::getproperty ===" test "getproperty content" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [mime::getproperty $token content] mime::finalize $token expr {$result eq "text/plain"} } 1 test "getproperty encoding" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [mime::getproperty $token encoding] mime::finalize $token expr {$result eq ""} } 1 test "getproperty size" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [mime::getproperty $token size] mime::finalize $token expr {$result == 4} } 1 # ============================================================================ # Test 12: mime::initialize with different content types # ============================================================================ puts "\n=== Test Group 12: mime::initialize ===" test "initialize with text/plain" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [mime::getproperty $token content] mime::finalize $token expr {$result eq "text/plain"} } 1 test "initialize with text/html" { set token [mime::initialize -canonical "text/html" -string ""] set result [mime::getproperty $token content] mime::finalize $token expr {$result eq "text/html"} } 1 test "initialize with application/octet-stream" { set token [mime::initialize -canonical "application/octet-stream" -string "binary"] set result [mime::getproperty $token content] mime::finalize $token expr {$result eq "application/octet-stream"} } 1 # ============================================================================ # Test 13: mime::setheader with different modes # ============================================================================ puts "\n=== Test Group 13: mime::setheader modes ===" test "setheader write mode" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::setheader $token X-Test "value1" -mode write set result [mime::getheader $token X-Test] mime::finalize $token expr {$result eq "value1"} } 1 test "setheader append mode" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::setheader $token X-Test "value1" mime::setheader $token X-Test "value2" -mode append set result [mime::getheader $token X-Test] mime::finalize $token string match "*value1*value2*" $result } 1 # ============================================================================ # Test 14: mime::encodingasciiP with various edge cases # ============================================================================ puts "\n=== Test Group 14: mime::encodingasciiP edge cases ===" test "encodingasciiP with carriage return at line end" { # encodingasciiP checks for \r only at line ends, not in middle mime::encodingasciiP "Hello\nWorld" } 1 test "encodingasciiP with control characters" { mime::encodingasciiP "Hello\x00World" } 0 test "encodingasciiP with high ASCII" { mime::encodingasciiP "Hello\x80World" } 0 test "encodingasciiP with spaces and tabs" { mime::encodingasciiP "Hello \t World" } 1 # ============================================================================ # Test 15: mime::qp_decode with various encodings # ============================================================================ puts "\n=== Test Group 15: mime::qp_decode edge cases ===" test "qp_decode with multiple encoded chars" { set encoded "=48=65=6C=6C=6F" set result [mime::qp_decode $encoded] string match "*Hello*" $result } 1 test "qp_decode with trailing soft newline" { set encoded "Hello World=\n" set result [mime::qp_decode $encoded] # Soft newline removes the newline string match "*Hello World*" $result } 1 test "qp_decode with backslash" { set encoded "Hello\\\\World" set result [mime::qp_decode $encoded] # Backslash is protected for subst expr {[string length $result] > 0} } 1 # ============================================================================ # Test 16: mime::parseaddress with complex formats # ============================================================================ puts "\n=== Test Group 16: mime::parseaddress complex formats ===" test "parseaddress with quoted string" { set result [mime::parseaddress "\"John Doe\" "] llength $result } 1 test "parseaddress with route" { set result [mime::parseaddress "@route.com:user@example.com"] llength $result } 1 test "parseaddress with group" { set result [mime::parseaddress "Friends: user1@example.com, user2@example.com;"] expr {[llength $result] >= 2} } 1 # ============================================================================ # Test 17: mime::initialize with file content # ============================================================================ puts "\n=== Test Group 17: mime::initialize with file ===" test "initialize with file content" { set tmpfile [file tempfile] set fd [open $tmpfile w] puts -nonewline $fd "Test file content" close $fd set token [mime::initialize -canonical "text/plain" -file $tmpfile] set result [mime::getproperty $token content] mime::finalize $token file delete $tmpfile expr {$result eq "text/plain"} } 1 # ============================================================================ # Test 18: mime::setheader with special headers # ============================================================================ puts "\n=== Test Group 18: mime::setheader special headers ===" test "setheader Content-Type (cannot be set directly)" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [catch {mime::setheader $token Content-Type "text/html; charset=utf-8" -internal 1} err] mime::finalize $token expr {$result == 1} } 1 test "setheader Content-Transfer-Encoding (cannot be set directly)" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [catch {mime::setheader $token Content-Transfer-Encoding "base64" -internal 1} err] mime::finalize $token expr {$result == 1} } 1 test "setheader MIME-Version" { set token [mime::initialize -canonical "text/plain" -string "Test"] mime::setheader $token MIME-Version "1.0" -internal 1 set result [mime::getheader $token MIME-Version] mime::finalize $token string match "*1.0*" $result } 1 # ============================================================================ # Test 19: mime::getproperty with all properties # ============================================================================ puts "\n=== Test Group 19: mime::getproperty all properties ===" test "getproperty params" { set token [mime::initialize -canonical "text/plain; charset=utf-8" -string "Test"] set result [mime::getproperty $token params] mime::finalize $token # params returns a list of key-value pairs expr {[llength $result] >= 0} } 1 test "getproperty all" { set token [mime::initialize -canonical "text/plain" -string "Test"] set result [mime::getproperty $token] mime::finalize $token expr {[llength $result] > 0} } 1 # ============================================================================ # Test 20: mime::copymessage with different encodings # ============================================================================ puts "\n=== Test Group 20: mime::copymessage with encodings ===" test "copymessage with different content types" { set token [mime::initialize -canonical "application/octet-stream" -string "Test content"] set tmpfile [file tempfile] set fd [open $tmpfile w+] mime::copymessage $token $fd close $fd file delete $tmpfile mime::finalize $token expr {1} } 1 test "copymessage with multipart" { set token [mime::initialize -canonical "multipart/mixed" -parts [list]] set tmpfile [file tempfile] set fd [open $tmpfile w+] mime::copymessage $token $fd close $fd file delete $tmpfile mime::finalize $token expr {1} } 1 # ============================================================================ # Summary # ============================================================================ puts "\n==========================================" puts "Test Summary" puts "==========================================" puts "Total Tests: $test_count" puts "Passed: $test_passed" puts "Failed: $test_failed" puts "==========================================" if {$test_failed > 0} { exit 1 } else { exit 0 }