punkshell/scriptlib/tests/mime.tcl

#!/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 <john@example.com>"]
    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 "<html></html>"]
    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\" <john@example.com>"]
    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
}