path: root/tests/bigdata.test

# Test cases for large sized data
#
# Copyright © 2023 Ashok P. Nadkarni
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest

    namespace import -force ::tcltest::*
}

#
# Hints:
#
# - To save time, when commands do not modify operands, generate the test data
# and run multiple variants of the command in a single test.
# - Do NOT use -setup clauses that generate large data. They seem to be run
# irrespective of whether the test itself is run.

# Wrapper to generate compiled and uncompiled cases for a test.
# If $args does not contain a -body key, $comment is treated as the test body
proc bigtest {id comment result args} {
    if {[dict exists $args -body]} {
        set body [dict get $args -body]
        dict unset args -body
    } else {
        set body $comment
    }
    dict lappend args -constraints bigdata

    uplevel 1 [list test $id.uncompiled "$comment (uncompiled)" \
                   -body [list testevalex $body] \
                   -result $result \
                   {*}$args]

    uplevel 1 [list test $id.compiled-script "$comment (compiled script)" \
                   -body [list try $body] \
                   -result $result \
                   {*}$args]

    return

    # TODO - is this required separately from the compile-script above?
    dict append args -setup \n[list proc testxproc {} $body]
    dict append args -cleanup "\nrename testxproc {}"
    uplevel 1 [list test $id.compiled-proc "$comment (compiled proc)" \
                   -body {testxproc} \
                   -result $result \
                   {*}$args]
}

# Like bigtest except that both compiled and uncompiled are combined into one
# test using the same inout argument. This saves considerable time but for
# obvious reasons should only be used when the input argument is not modified.
proc bigtestRO {id comment result args} {
    if {[dict exists $args -body]} {
        set body [dict get $args -body]
        dict unset args -body
    } else {
        set body $comment
    }
    dict lappend args -constraints bigdata

    set wrapper ""
    set body "{$body}"
    append wrapper "set uncompiled_result \[testevalex $body]" \n
    append wrapper "set compiled_result \[try $body]" \n
    append wrapper {list $uncompiled_result $compiled_result}
    uplevel 1 [list test $id {$comment} \
                   -body $wrapper \
                   -result [list $result $result] \
                   {*}$args]
    return
}

interp alias {} bigString {} testbigdata string
proc xxbigString args {
    puts bigStringEnter:$args
    set xx [testbigdata string {*}$args]
    puts bigStringExit
    return $xx
}
interp alias {} bigBinary {} testbigdata bytearray
interp alias {} bigList {} testbigdata list
proc bigPatLen {} {
    proc bigPatLen {} "return [string length [testbigdata string]]"
    bigPatLen
}

# Returns list of expected elements at the indices specified
proc bigStringIndices {indices} {
    set pat [testbigdata string]
    set patlen [string length $pat]
    lmap idx $indices {
        string index $pat [expr {$idx%$patlen}]
    }
}

# Returns the largest multiple of the pattern length that is less than $limit
proc bigPatlenMultiple {limit} {
    set patlen [bigPatLen]
    return [expr {($limit/$patlen)*$patlen}]
}

set ::bigLengths(intmax) 0x7fffffff
set ::bigLengths(uintmax) 0xffffffff
# Some tests are more convenient if operands are multiple of pattern length
set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)]
set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)]

#
# string cat
bigtest string-cat-bigdata-1 "string cat large small result > INT_MAX" 1 -body {
    string equal \
        [string cat [bigString $::bigLengths(patlenmultiple)] [bigString]] \
        [bigString [expr {[bigPatLen]+$::bigLengths(patlenmultiple)}]]
}
bigtest string-cat-bigdata-2 "string cat small large result > INT_MAX" 1 -body {
    string equal \
        [string cat [bigString] [bigString $::bigLengths(patlenmultiple)]] \
        [bigString [expr {[bigPatLen]+$::bigLengths(patlenmultiple)}]]
}
bigtest string-cat-bigdata-3 "string cat result > UINT_MAX" 1 -body {
    set s [bigString $::bigLengths(patlenmultiple)]
    string equal \
        [string cat $s [bigString] $s] \
        [bigString [expr {[bigPatLen]+2*$::bigLengths(patlenmultiple)}]]
}

#
# string compare/equal
bigtestRO string-equal/compare-bigdata-1 "string compare/equal equal strings" {0 1} -body {
    list [string compare $s1 $s2] [string equal $s1 $s2]
} -setup {
    set len [expr {$::bigLengths(intmax)+1}]
    set s1 [bigString $len]
    set s2 [bigString $len]; # Use separate string to avoid Tcl_Obj * being same
} -cleanup {
    unset -nocomplain s1 s2
}
bigtestRO string-equal/compare-bigdata-2 "string compare/equal -length unequal strings" {-1 0 0 1} -body {
    # Also tests lengths do not wrap
    set result {}
    lappend result [string compare $s1 $s2]
    lappend result [string equal $s1 $s2]
    # Check lengths > UINT_MAX
    # Also that lengths do not truncate to sizeof(int)
    lappend result [string compare -length $len $s1 $s2]
    lappend result [string equal -length $len $s1 $s2]
} -setup {
    set len [expr {$::bigLengths(uintmax)+2}]
    set s1 [bigString $len]
    set s2 [bigString $len $len]; # Differs in last char
} -cleanup {
    unset -nocomplain s1 s2
}

#
# string first
bigtestRO string-first-bigdata-1 "string first > INT_MAX" {2147483648 -1 2147483650 1} -body {
    list \
        [string first X $s] \
        [string first Y $s] \
        [string first 0 $s 0x80000000] \
        [string first 1 $s end-0x80000010]
} -setup {
    set s [bigString 0x8000000a 0x80000000]
} -cleanup {
    unset -nocomplain s
} -constraints bug-a814ee5bbd

bigtestRO string-first-bigdata-2 "string first > UINT_MAX" {4294967296 -1 4294967300 1} -body {
    list \
        [string first X $s] \
        [string first Y $s] \
        [string first 0 $s 0x100000000] \
        [string first 1 $s end-0x100000010]
} -setup {
    set s [bigString 0x10000000a 0x100000000]
} -cleanup {
    unset -nocomplain s
} -constraints bug-a814ee5bbd

bigtestRO string-first-bigdata-3 "string first - long needle" 10 -body {
    string first $needle $s
} -setup {
    set s [bigString 0x10000000a 0]
    set needle [bigString 0x100000000]
} -cleanup {
    unset -nocomplain s needle
} -constraints bug-a814ee5bbd

#
# string index
bigtestRO string-index-bigdata-1 "string index" {6 7 5 {} 5 4 {} 9 {}} -body {
    list \
        [string index $s 0x100000000] \
        [string index $s 0x100000000+1] \
        [string index $s 0x100000000-1] \
        [string index $s 0x10000000a] \
        [string index $s end] \
        [string index $s end-1] \
        [string index $s end+1] \
        [string index $s end-0x100000000] \
        [string index $s end-0x10000000a]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    unset -nocomplain s
}

#
# string insert
bigtestRO string-insert-bigdata-1 "string insert" 1 -body {
    # Note insert at multiple of 10 to enable comparison against generated string
    string equal [string insert [bigString 4294967312] 4294967310 "0123456789"] [bigString 4294967322]
}
bigtestRO string-insert-bigdata-2 "string insert" 1 -body {
    string equal [string insert [bigString 4294967312] 10 "0123456789"] [bigString 4294967322]
}

#
# string is
bigtestRO string-is-bigdata-1 "string is" {1 0 0 4294967296} -body {
    # TODO - add the other "is" classes
    unset -nocomplain failat result
    lappend result [string is alnum -failindex failat $s] [info exists failat]
    lappend result [string is digit -failindex failat $s] $failat
} -setup {
    set s [bigString 0x10000000a 0x100000000]
} -cleanup {
    unset -nocomplain s failat
}

#
# string last
bigtestRO string-last-bigdata-1 "string last > INT_MAX" {2 -1 2147483640 11} -body {
    set s [bigString 0x80000010 2]
    list \
        [string last X $s] \
        [string last Y $s] \
        [string last 0 $s 0x80000000] \
        [string last 1 $s end-0x80000000]
} -setup {
    set s [bigString 0x80000010 2]
} -cleanup {
    unset -nocomplain s
} -constraints bug-a814ee5bbd

bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 4294967290 1} -body {
    list \
        [string last 0 $s] \
        [string last Y $s] \
        [string last 0 $s 0x100000000] \
        [string last 1 $s end-0x100000010]
} -setup {
    set s [bigString 0x10000000a 2]
} -cleanup {
    unset -nocomplain s
} -constraints bug-a814ee5bbd

bigtestRO string-last-bigdata-3 "string last - long needle" 0 -body {
    string last $needle $s
} -setup {
    set s [bigString 0x10000000a 0x10000000a]
    set needle [bigString 0x100000000]
} -cleanup {
    unset -nocomplain s needle
} -constraints bug-a814ee5bbd

#
# string length
bigtestRO string-length-bigdata-1 {string length $s} 4294967296 -setup {
    set s [bigString 0x100000000]
} -cleanup {
    unset -nocomplain s
}

#
# string map
bigtestRO string-map-bigdata-1 {string map} {5 0 0 5} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string map {0 5 5 0} $s]
    list \
        [string index $s2 0] \
        [string index $s2 5] \
        [string index $s2 end] \
        [string index $s2 end-5]
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    unset -nocomplain s s2
} -constraints takesTooLong

#
# string match
bigtestRO string-match-bigdata-1 {string match} {1 0 1} -body {
    list \
        [string match 0*5 $s] \
        [string match 0*4 $s] \
        [string match $s $s]
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    unset -nocomplain s
}

#
# string range
bigtestRO string-range-bigdata-1 "string range" {6 7 5 {} 5 4 {} 9 {}} -body {
    list \
        [string range $s 0x100000000 0x100000000] \
        [string range $s 0x100000000+1 0x100000000+1] \
        [string range $s 0x100000000-1 0x100000000-1] \
        [string range $s 0x10000000a 0x10000000a] \
        [string range $s end end] \
        [string range $s end-1 end-1] \
        [string range $s end+1 end+1] \
        [string range $s end-0x100000000 end-0x100000000] \
        [string range $s end-0x10000000a end-0x10000000a]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    unset -nocomplain s
} -constraints bug-ad9361fd20f0
# TODO - once above bug is fixed, add tests for large result range

#
# string repeat
bigtest string-repeat-bigdata-1 "string repeat single char length > UINT_MAX" 4294967296 -body {
    string length [string repeat x 0x100000000]
}
bigtest string-repeat-bigdata-2 "string repeat multiple char" {4294967296 0123456789abcdef 0123456789abcdef} -body {
    set s [string repeat 0123456789abcdef [expr 0x100000000/16]]
    list \
        [string length $s] \
        [string range $s 0 15] \
        [string range $s end-15 end]
} -cleanup {
    unset -nocomplain s
}

#
# string replace
bigtestRO string-replace-bigdata-1 "string replace" {789012345 012345678 XYZ789012345 012345678XYZ} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain result
    lappend result [string replace $s 0 0x100000000]
    lappend result [string replace $s end-0x100000000 end]
    lappend result [string replace $s 0 0x100000000 XYZ]
    lappend result [string replace $s end-0x100000000 end XYZ]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    unset -nocomplain s
} -constraints bug-ad9361fd20f0
# TODO - once above bug is fixed, add tests for large result range:
# - replacements string is large
# - replace in the middle - string length grows, shrinks
# - last < first

#
# string reverse
bigtestRO string-reverse-bigdata-1 "string reverse" {5432109876 9876543210} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string reverse $s]
    list [string range $s2 0 9] [string range $s2 end-9 end]
} -setup {
    set s [bigString 0x10000000a]
} -cleanup {
    unset -nocomplain s s2
}

#
# string tolower
bigtestRO string-tolower-bigdata-1 "string tolower" 1 -body {
    string equal [string tolower $s] [string repeat abcd $repts]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat ABCD $repts]
} -cleanup {
    unset -nocomplain s repts
}
bigtestRO string-tolower-bigdata-2 "string tolower first last" {4294967312 ABCDabcdABCD 4294967312 ABCDabcdABCD 4294967312 ABCDabcdABCD} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string tolower $s 4 7]
    lappend result [string length $s2] [string range $s2 0 11]

    unset s2; #Explicit free to reduce total memory
    set s2 [string tolower $s 0x100000008 0x10000000b]
    lappend result [string length $s2] [string range $s2 0x100000004 end]

    unset s2; #Explicit free to reduce total memory
    set s2 [string tolower $s end-7 end-4]
    lappend result [string length $s2] [string range $s2 0x100000004 end]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat ABCD $repts]
} -cleanup {
    unset -nocomplain s s2 repts
}

#
# string totitle
bigtestRO string-totitle-bigdata-1 "string totitle first last" {4294967312 aBcDAbcdaBcD 4294967312 aBcDAbcdaBcD 4294967312 aBcDAbcdaBcD} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string totitle $s 4 7]
    lappend result [string length $s2] [string range $s2 0 11]
    unset s2; #Explicit free to reduce total memory
    set s2 [string totitle $s 0x100000008 0x10000000b]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
    unset s2; #Explicit free to reduce total memory
    set s2 [string totitle $s end-7 end-4]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat aBcD $repts]
} -cleanup {
    unset -nocomplain s s2 repts
}

#
# string toupper
bigtestRO string-toupper-bigdata-1 "string toupper" 1 -body {
    string equal [string toupper $s] [string repeat ABCD $repts]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat abcd $repts]
} -cleanup {
    unset -nocomplain s repts
}
bigtestRO string-toupper-bigdata-2 "string toupper first last" {4294967312 abcdABCDabcd 4294967312 abcdABCDabcd 4294967312 abcdABCDabcd} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2 result
    set s2 [string toupper $s 4 7]
    lappend result [string length $s2] [string range $s2 0 11]
    unset s2; #Explicit free to reduce total memory
    set s2 [string toupper $s 0x100000008 0x10000000b]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
    unset s2; #Explicit free to reduce total memory
    set s2 [string toupper $s end-7 end-4]
    lappend result [string length $s2] [string range $s2 0x100000004 0x10000000f]
} -setup {
    set repts [expr 0x100000010/4]
    set s [string repeat abcd $repts]
} -cleanup {
    unset -nocomplain s s2 repts
}

#
# string trim
bigtestRO string-trim-bigdata-1 "string trim" {abcdyxxy yxxyabcd} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string trim $s xy]
    list [string range $s2 0 7] [string range $s2 end-7 end]
} -setup {
    set repts [expr 0x100000010/8]
    set s [string repeat xyabcdyx $repts]
} -cleanup {
    unset -nocomplain s s2
}

#
# string trimleft
bigtestRO string-trimleft-bigdata-1 "string trimleft" {abcdyxxy xyabcdyx} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string trimleft $s xy]
    list [string range $s2 0 7] [string range $s2 end-7 end]
} -setup {
    set repts [expr 0x100000010/8]
    set s [string repeat xyabcdyx $repts]
} -cleanup {
    unset -nocomplain s s2
}

#
# string trimright
bigtestRO string-trimright-bigdata-1 "string trimright" {xyabcdyx yxxyabcd} -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [string trimright $s xy]
    list [string range $s2 0 7] [string range $s2 end-7 end]
} -setup {
    set repts [expr 0x100000010/8]
    set s [string repeat xyabcdyx $repts]
} -cleanup {
    unset -nocomplain s s2
}

#
# append
bigtestRO append-bigdata-1 "append large to small" 1 -body {
    set s 0123456789
    append s [bigString 0x100000000]
    string equal $s [bigString 0x10000000a]
} -cleanup {
    unset -nocomplain s
}
bigtest append-bigdata-2 "append small to cross UINT_MAX boundary" 1 -body {
    append s 0123456789
    string equal $s [bigString 4294967300]
} -setup {
    set s [bigString 4294967290]
} -cleanup {
    unset -nocomplain s
}
bigtest append-bigdata-3 "append small to cross UINT_MAX boundary" 1 -body {
    set s2 ""
    append s2 $s $s $s $s
    string equal $s2 [bigString 4294967320]
} -setup {
    # Make length multiple of 4 AND 10 since the bigString pattern length is 10
    set len [expr 4294967320/4]
    set s [bigString $len]
} -cleanup {
    unset -nocomplain s
}

#
# format
bigtestRO format-bigdata-1 "format %s" 1 -body {
    # Unset explicitly before setting to save memory as bigtestRO runs the
    # script below twice.
    unset -nocomplain s2
    set s2 [format %s $s]
    string equal $s $s2
} -setup {
    set s [bigString 0x100000000]
} -cleanup {
    unset -nocomplain s s2
} -constraints bug-a550f9710b
bigtest format-bigdata-2 "format bigstring%s" 1 -body {
    set s [format $s X]
    string equal $s [bigString 0x100000001 0x100000000]
} -setup {
    set s [bigString 0x100000000]
    append s %s
} -cleanup {
    unset -nocomplain s s2
} -constraints bug-a550f9710b
# TODO - once above bugs fixed, add tests for width and precision

# scan
# regexp
# regsub


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# fill-column: 78
# End: