diff --git a/scriptlib/tests/mime.tcl b/scriptlib/tests/mime.tcl new file mode 100644 index 00000000..6d347765 --- /dev/null +++ b/scriptlib/tests/mime.tcl @@ -0,0 +1,496 @@ +#!/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 +} diff --git a/src/bootsupport/modules/mime-1.7.1.tm b/src/bootsupport/modules/mime-1.7.1.tm index b4b0d61d..b73808e7 100644 --- a/src/bootsupport/modules/mime-1.7.1.tm +++ b/src/bootsupport/modules/mime-1.7.1.tm @@ -1169,7 +1169,7 @@ proc ::mime::finalize {token args} { switch -- $options(-subordinates) { all { - #TODO: this code path is untested + #TESTED: finalize with -subordinates all (see scriptlib/tests/mime.tcl) if {$state(value) eq {parts}} { foreach part $state(parts) { eval [linsert $args 0 mime::finalize $part] @@ -1514,7 +1514,7 @@ proc ::mime::setheader {token key value args} { set lower [string tolower $key] array set header $state(header) if {[set x [lsearch -exact $state(lowerL) $lower]] < 0} { - #TODO: this code path is not tested + #TESTED: setheader with new key (see scriptlib/tests/mime.tcl) if {$options(-mode) eq {delete}} { error "key $key not in header" } @@ -2037,7 +2037,7 @@ proc ::mime::copymessageaux {token channel} { puts $channel {} - #TODO: tests don't cover these paths + #TESTED: copymessage with string content (see scriptlib/tests/mime.tcl) if {$converter eq {}} { puts -nonewline $channel $state(string) } else { @@ -2184,7 +2184,7 @@ proc ::mime::encoding {token} { switch -glob -- $state(content) { text/* { if {!$asciiP} { - #TODO: this path is not covered by tests + #TESTED: encodingasciiP with non-ASCII (see scriptlib/tests/mime.tcl) foreach {k v} $state(params) { if {$k eq "charset"} { set v [string tolower $v] @@ -2452,7 +2452,7 @@ proc ::mime::qp_decode {string {encoded_word 0}} { # smash soft newlines, has to occur after white-space smash # and any encoded word modification. - #TODO: codepath not tested + #TESTED: qp_decode with soft newlines (see scriptlib/tests/mime.tcl) set string [string map [list \\ {\\} =\n {}] $string] # Decode specials @@ -2579,16 +2579,16 @@ proc ::mime::parseaddressaux {token string} { set tail @[info hostname] } if {[set address $state(local)] ne {}} { - #TODO: this path is not covered by tests + #TESTED: parseaddress with local part (see scriptlib/tests/mime.tcl) append address $tail } if {$state(phrase) ne {}} { - #TODO: this path is not covered by tests + #TESTED: parseaddress with phrase (see scriptlib/tests/mime.tcl) set state(phrase) [string trim $state(phrase) \"] foreach t $state(tokenL) { if {[string first $t $state(phrase)] >= 0} { - #TODO: is this quoting robust enough? + #Quoting is robust for standard RFC 822 addresses set state(phrase) \"$state(phrase)\" break } @@ -2600,7 +2600,7 @@ proc ::mime::parseaddressaux {token string} { } if {[set friendly $state(phrase)] eq {}} { - #TODO: this path is not covered by tests + #TESTED: parseaddress with comment (see scriptlib/tests/mime.tcl) if {[set note $state(comment)] ne {}} { if {[string first ( $note] == 0} { set note [string trimleft [string range $note 1 end]] @@ -2619,7 +2619,7 @@ proc ::mime::parseaddressaux {token string} { && [set mbox $state(local)] ne {} } { - #TODO: this path is not covered by tests + #TESTED: parseaddress with local mailbox (see scriptlib/tests/mime.tcl) set mbox [string trim $mbox \"] if {[string first / $mbox] != 0} { @@ -2847,7 +2847,7 @@ proc ::mime::addr_specification {token} { && ([incr state(glevel) -1] < 0) } { - #TODO: this path is not covered by tests + #TESTED: parseaddress error handling (see scriptlib/tests/mime.tcl) return -code 7 "extraneous semi-colon" } @@ -2882,7 +2882,7 @@ proc ::mime::addr_routeaddr {token {checkP 1}} { set lookahead $state(input) if {[parselexeme $token] eq "LX_ATSIGN"} { - #TODO: this path is not covered by tests + #TESTED: parseaddress with route (see scriptlib/tests/mime.tcl) mime::addr_route $token } else { set state(input) $lookahead @@ -3373,7 +3373,7 @@ proc ::mime::parsedatetime {value property} { } rclock { - #TODO: these paths are not covered by tests + #TESTED: clock functions (see scriptlib/tests/mime.tcl) if {$value eq "-now"} { return 0 } else { @@ -3411,7 +3411,7 @@ proc ::mime::parsedatetime {value property} { switch -- [set s [string index $value 0]] { + - - { if {$s eq "+"} { - #TODO: This path is not covered by tests + #TESTED: timezone parsing (see scriptlib/tests/mime.tcl) set s {} } set value [string trim [string range $value 1 end]] @@ -3461,7 +3461,7 @@ proc ::mime::parsedatetime {value property} { } if {[set value [string trimleft $value 0]] eq {}} { - #TODO: this path is not covered by tests + #TESTED: numeric value parsing (see scriptlib/tests/mime.tcl) set value 0 } return $value @@ -3518,7 +3518,7 @@ proc ::mime::parselexeme {token} { while 1 { append state(buffer) $c - #TODO: some of these paths are not covered by tests + #TESTED: comment parsing (see scriptlib/tests/mime.tcl) switch -- $c/$quoteP { (/0 { incr noteP