###############################################################################
#
# regsub.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
#
# Copyright (c) 2007-2012 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

source [file join [file normalize [file dirname [info script]]] prologue.eagle]

###############################################################################
# MONO: Due to a Mono bug, some tests are disabled on Mono.
#       See: https://bugzilla.novell.com/show_bug.cgi?id=636939
###############################################################################

proc foo { args } {lappend ::z $args; return $args}
proc bar { args } {lappend ::z $args; return ""}
proc splog { args } {lappend ::z $args; break}

###############################################################################

runTest {test regsub-98.1 {regsub -args handling} -setup {
  unset -nocomplain test pattern string
} -body {
  set pattern this
  set string "this is a test."

  list [regsub -- $pattern $string {\P} test] $test \
      [regsub -- $pattern $string {\I} test] $test \
      [regsub -- $pattern $string {\S} test] $test \
      [regsub -- $pattern $string {\S that} test] $test \
      [regsub -args -- $pattern $string {\P} test] $test \
      [regsub -args -- $pattern $string {\I} test] $test \
      [regsub -args -- $pattern $string {\S} test] $test \
      [regsub -args -- $pattern $string {\S that} test] $test
} -cleanup {
  unset -nocomplain test pattern string
} -constraints {eagle} -result {1 {\P is a test.} 1 {\I is a test.} 1 {\S is a\
test.} 1 {\S that is a test.} 1 {this is a test.} 1 {this is a test. is a\
test.} 1 {\S is a test.} 1 {\S that that is a test.}}}

###############################################################################

runTest {test regsub-98.2 {regsub subSpec backslash handling} -setup {
  unset -nocomplain test pattern string
} -body {
  set pattern (this)
  set string "this is a test."

  list [regsub -- $pattern $string {"} test] $test \
      [regsub -- $pattern $string {\"} test] $test \
      [regsub -- $pattern $string \\ test] $test \
      [regsub -- $pattern $string {\\} test] $test \
      [regsub -- $pattern $string \\\\ test] $test \
      [regsub -- $pattern $string {\\\\} test] $test \
      [regsub -- $pattern $string \\\\\\ test] $test \
      [regsub -- $pattern $string {\\\\\\} test] $test \
      [regsub -- $pattern $string {&} test] $test \
      [regsub -- $pattern $string {\&} test] $test \
      [regsub -- $pattern $string {0} test] $test \
      [regsub -- $pattern $string {\0} test] $test \
      [regsub -- $pattern $string {1} test] $test \
      [regsub -- $pattern $string {\1} test] $test \
      [regsub -- $pattern $string {2} test] $test \
      [regsub -- $pattern $string {\2} test] $test \
      [regsub -- $pattern $string {n} test] $test \
      [regsub -- $pattern $string {\n} test] $test
} -cleanup {
  unset -nocomplain test pattern string
} -result {1 {" is a test.} 1 {\" is a test.} 1 {\ is a test.} 1 {\ is a test.}\
1 {\ is a test.} 1 {\\ is a test.} 1 {\\ is a test.} 1 {\\\ is a test.} 1 {this\
is a test.} 1 {& is a test.} 1 {0 is a test.} 1 {this is a test.} 1 {1 is a\
test.} 1 {this is a test.} 1 {2 is a test.} 1 { is a test.} 1 {n is a test.} 1\
{\n is a test.}}}

###############################################################################

runTest {test regsub-98.3 {regsub subSpec backslash -nostrict} -setup {
  unset -nocomplain test pattern string
} -body {
  set pattern (this)
  set string "this is a test."

  list [regsub -nostrict -- $pattern $string {"} test] $test \
      [regsub -nostrict -- $pattern $string {\"} test] $test \
      [regsub -nostrict -- $pattern $string \\ test] $test \
      [regsub -nostrict -- $pattern $string {\\} test] $test \
      [regsub -nostrict -- $pattern $string \\\\ test] $test \
      [regsub -nostrict -- $pattern $string {\\\\} test] $test \
      [regsub -nostrict -- $pattern $string \\\\\\ test] $test \
      [regsub -nostrict -- $pattern $string {\\\\\\} test] $test \
      [regsub -nostrict -- $pattern $string {&} test] $test \
      [regsub -nostrict -- $pattern $string {\&} test] $test \
      [regsub -nostrict -- $pattern $string {0} test] $test \
      [regsub -nostrict -- $pattern $string {\0} test] $test \
      [regsub -nostrict -- $pattern $string {1} test] $test \
      [regsub -nostrict -- $pattern $string {\1} test] $test \
      [regsub -nostrict -- $pattern $string {2} test] $test \
      [regsub -nostrict -- $pattern $string {\2} test] $test \
      [regsub -nostrict -- $pattern $string {n} test] $test \
      [regsub -nostrict -- $pattern $string {\n} test] $test
} -cleanup {
  unset -nocomplain test pattern string
} -constraints {eagle} -result {1 {" is a test.} 1 {" is a test.} 1 {\ is a\
test.} 1 {\ is a test.} 1 {\ is a test.} 1 {\\ is a test.} 1 {\\ is a test.} 1\
{\\\ is a test.} 1 {this is a test.} 1 {& is a test.} 1 {0 is a test.} 1 {this\
is a test.} 1 {1 is a test.} 1 {this is a test.} 1 {2 is a test.} 1 { is a\
test.} 1 {n is a test.} 1 {n is a test.}}}

###############################################################################

runTest {test regsub-98.4 {regsub -eval script without -args} -setup {
  unset -nocomplain test script pattern string subSpec
} -body {
  set script {
    list "\\P" "\\I" "\\S"
  }

  set pattern (this)
  set string "this is a test."
  set subSpec that

  list [regsub -eval $script -- $pattern $string $subSpec test] $test
} -cleanup {
  unset -nocomplain test script pattern string subSpec
} -constraints {eagle} -result {1 {{\P} {\I} {\S} is a test.}}}

###############################################################################

runTest {test regsub-98.5 {regsub -eval script with -args} -setup {
  unset -nocomplain test script pattern string subSpec
} -body {
  set script {
    list "\\P" "\\I" "\\S"
  }

  set pattern (this)
  set string "this is a test."
  set subSpec that

  list [regsub -eval $script -args -- $pattern $string $subSpec test] $test
} -cleanup {
  unset -nocomplain test script pattern string subSpec
} -constraints {eagle} -result {1 {(this) {this is a test.} that is a test.}}}

###############################################################################

runTest {test regsub-99.1 {regsub -eval/override matches no cap all} -setup {
  unset -nocomplain ::z
} -body {
  regsub -eval [list foo \\0 \\1 \\2 \\& & \\\\] -all -nocase -- {.*} \
      "this is a test..." ""
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{this is a test...} {} {} &\
{this is a test...} \\{} {} {} & {} \\}}

###############################################################################

runTest {test regsub-99.2 {regsub -eval, error} -body {
  regsub -eval [list error "bad replacement..."] -all -nocase -- {.*} \
      "this is a test..." ""
} -constraints {eagle} -returnCodes 1 -result {bad replacement...}}

###############################################################################

runTest {test regsub-99.3 {regsub double output} -setup {
  unset -nocomplain test
} -body {
  list [regsub -all -nocase -- {.} "this is a test..." "\\0\\0" test] [set test]
} -cleanup {
  unset -nocomplain test
} -result {17 {tthhiiss  iiss  aa  tteesstt......}}}

###############################################################################

runTest {test regsub-99.4 {regsub -eval/override matches cap all} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\0 \\1 \\2 \\& & \\\\] -all -nocase -- {(.*)} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{{this is a test...} {this is a test...} {} &\
{this is a test...} \\{} {} {} & {} \\} {{{this is a test...}\
{this is a test...} {} & {this is a test...} \\} {{} {} {} & {} \\}}}}

###############################################################################

runTest {test regsub-99.5 {regsub -eval/default matches cap all} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list bar \\0 \\1 \\2 \\& & \\\\] -all -nocase -- {(.*)} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{} {{{this is a test...} {this is a test...}\
{} & {this is a test...} \\} {{} {} {} & {} \\}}}}

###############################################################################

runTest {test regsub-99.6 {regsub -eval/override matches no cap} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\0 \\1 \\2 \\& & \\] -all -nocase -- {.} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{t {} {} & t \\h {} {} & h \\i {} {} & i\
\\s {} {} & s \\{ } {} {} & { } \\i {} {} & i \\s {} {} & s \\{ } {} {} & { }\
\\a {} {} & a \\{ } {} {} & { } \\t {} {} & t \\e {} {} & e \\s {} {} & s\
\\t {} {} & t \\. {} {} & . \\. {} {} & . \\. {} {} & . \\} {{t {} {} & t \\}\
{h {} {} & h \\} {i {} {} & i \\} {s {} {} & s \\} {{ } {} {} & { } \\}\
{i {} {} & i \\} {s {} {} & s \\} {{ } {} {} & { } \\} {a {} {} & a \\}\
{{ } {} {} & { } \\} {t {} {} & t \\} {e {} {} & e \\} {s {} {} & s \\}\
{t {} {} & t \\} {. {} {} & . \\} {. {} {} & . \\} {. {} {} & . \\}}}}

###############################################################################

runTest {test regsub-99.7 {regsub -eval/override matches cap} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\0 \\1 \\2 \\& & \\] -all -nocase -- {(.)} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{t t {} & t \\h h {} & h \\i i {} & i\
\\s s {} & s \\{ } { } {} & { } \\i i {} & i \\s s {} & s \\{ } { } {} & { }\
\\a a {} & a \\{ } { } {} & { } \\t t {} & t \\e e {} & e \\s s {} & s\
\\t t {} & t \\. . {} & . \\. . {} & . \\. . {} & . \\} {{t t {} & t \\}\
{h h {} & h \\} {i i {} & i \\} {s s {} & s \\} {{ } { } {} & { } \\}\
{i i {} & i \\} {s s {} & s \\} {{ } { } {} & { } \\} {a a {} & a \\}\
{{ } { } {} & { } \\} {t t {} & t \\} {e e {} & e \\} {s s {} & s \\}\
{t t {} & t \\} {. . {} & . \\} {. . {} & . \\} {. . {} & . \\}}}}

###############################################################################

runTest {test regsub-99.8 {regsub -eval/override matches cap} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\0 \\1 \\2 \\& & \\\\] -all -nocase -- {(.)} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{t t {} & t \\h h {} & h \\i i {} & i\
\\s s {} & s \\{ } { } {} & { } \\i i {} & i \\s s {} & s \\{ } { } {} & { }\
\\a a {} & a \\{ } { } {} & { } \\t t {} & t \\e e {} & e \\s s {} & s\
\\t t {} & t \\. . {} & . \\. . {} & . \\. . {} & . \\} {{t t {} & t \\}\
{h h {} & h \\} {i i {} & i \\} {s s {} & s \\} {{ } { } {} & { } \\}\
{i i {} & i \\} {s s {} & s \\} {{ } { } {} & { } \\} {a a {} & a \\}\
{{ } { } {} & { } \\} {t t {} & t \\} {e e {} & e \\} {s s {} & s \\}\
{t t {} & t \\} {. . {} & . \\} {. . {} & . \\} {. . {} & . \\}}}}

###############################################################################

runTest {test regsub-99.9 {regsub -eval/override match missing} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\0] -all -nocase -- {[^this]} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{this{ }is{ }a{ }test...}\
{{{ }} {{ }} a {{ }} e . . .}}}

###############################################################################

runTest {test regsub-99.10 {regsub -eval/override sub-match missing} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\1] -all -nocase -- {[^this]} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {this{}is{}{}{}t{}st{}{}{}\
{{{}} {{}} {{}} {{}} {{}} {{}} {{}} {{}}}}}

###############################################################################

runTest {test regsub-99.11 {regsub -eval/override match} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\0] -all -nocase -- {[this]} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{this is a test...} {t h i s i s t s t}}}

###############################################################################

runTest {test regsub-99.12 {regsub -eval/override sub-match} -setup {
  unset -nocomplain ::z
} -body {
  list [regsub -eval [list foo \\1] -all -nocase -- {[this]} \
      "this is a test..." ""] $::z
} -cleanup {
  unset -nocomplain ::z
} -constraints {eagle} -result {{{}{}{}{} {}{} a {}e{}{}...}\
{{{}} {{}} {{}} {{}} {{}} {{}} {{}} {{}} {{}}}}}

###############################################################################

runTest {test regsub-99.13 {something regsub this way comes} -body {
  #
  # NOTE: Create a regular expression to capture "reserved" characters.
  #
  set exp {[][{};#\\\$\s\u0080-\uFFFF]}

  #
  # NOTE: Create a string with a lot of "reserved" characters.
  #
  set string {	
this is a test. \t\v\r\n ~`!@#$%^&*() []{}<>\|/?-_=+"'}

  #
  # NOTE: We will be substituting this short script fragment for each
  #       "reserved" character we find and then the entire result will go
  #       through [subst].  All the created objects will be captured into
  #       the "obj" variable for later cleanup.
  #
  set subSpec {[string format "\\\\u{0:X4}" \
        [object invoke -parametertypes Byte Convert ToInt16 \
            [set obj([incr idx]) \
                [object invoke -create \
                    [set obj([incr idx]) \
                        [object create String &]] Chars 0]]]]}

  set idx 0

  string map [list "\\u0020" " "] \
      [subst [regsub -all -quote -- $exp $string $subSpec]]
} -cleanup {
  unset -nocomplain exp string subSpec idx obj
} -constraints {eagle} -result \
{\u0009\u000A\u000B\u000Cthis is a test. \u005Ct\u005Cv\u005Cr\u005Cn\
~`!@\u0023\u0024%^&*() \u005B\u005D\u007B\u007D<>\u005C|/?-_=+"'}}

###############################################################################

runTest {test regsub-99.14 {regsub -eval nested} -setup {
  proc outerProc { arg } {
    regsub -eval [list innerProc $arg] -all -- {[st]} $arg ""
    lappend ::result [list o $arg [incr ::count(outer)]]
  }

  proc innerProc { arg } {
    lappend ::result [list i $arg [incr ::count(inner)]]
  }

  unset -nocomplain count result output
} -body {
  set count(outer) 0; set count(inner) 0; set count(total) 0

  incr count(total) [regsub -eval [list outerProc \\1] -all -- {([this])} \
      "this is a test..." "" output]

  list [list inner $count(inner) outer $count(outer) total $count(total)] \
      $result
} -cleanup {
  unset -nocomplain count result output

  rename innerProc ""
  rename outerProc ""
} -constraints {eagle} -result {{inner 6 outer 9 total 9} {{i t 1} {o t 1} {o h\
2} {o i 3} {i s 2} {o s 4} {o i 5} {i s 3} {o s 6} {i t 4} {o t 7} {i s 5} {o s\
8} {i t 6} {o t 9}}}}

###############################################################################

rename foo ""
rename bar ""
rename splog ""

###############################################################################

source [file join [file normalize [file dirname [info script]]] epilogue.eagle]
