# -*- tcl -*-
# rb.test:  test samples for the yaml library.
# http://yaml4r.sourceforge.net/cookbook/
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    # single test
    set selfrun 1
    lappend auto_path [pwd]
    package require tcltest
    namespace import ::tcltest::*
    puts [source huddle.tcl]
    puts [source yaml.tcl]
} else {
    # all.tcl
    source [file join \
        [file dirname [file dirname [file join [pwd] [info script]]]] \
        devtools testutilities.tcl]

    testsNeedTcl     8.3
    testsNeedTcltest 1.0

    if {$::tcl_version < 8.5} {
        if {[catch {package require dict}]} {
            puts "    Aborting the tests found in \"[file tail [info script]]\""
            puts "    Requiring dict package, not found."
            return
        }
    }

    testing {
        useLocal yaml.tcl yaml
    }
}

proc dictsort {dict} {
    array set a $dict
    set out [list]
    foreach key [lsort [array names a]] {
        lappend out $key $a($key)
    }
    return $out
}

proc dictsort2 {dict {pattern d}} {
    set cur  [lindex $pattern 0]
    set subs [lrange $pattern 1 end]
    foreach {tag sw} $cur break
    set out {}
    if {$sw ne ""} {array set msubs $sw}
    if {$tag eq "l"} { ; # list
        set i 0
        foreach {node} $dict {
            set subs1 $subs
            if {$sw ne "" && [info exists msubs($i)]} {
                set subs1 $msubs($i)
            }
            if {$subs1 ne ""} {
                set node [dictsort2 $node $subs1]
            }
            lappend out $node
            incr i
        }
        return $out
    }
    if {$tag eq "d"} { ; # dict
        array set map $dict
        foreach key [lsort [array names map]] {
            set node $map($key)
            set subs1 $subs
            if {$sw ne "" && [info exists msubs($key)]} {
                set subs1 $msubs($key)
            }
            if {$subs1 ne ""} {
                set node [dictsort2 $node $subs1]
            }
            lappend out $key $node
        }
        return $out
    }
    error
}

test yaml.rb-1 "Simple Sequence" -body {
    set data {
---
- apple 
- banana 
- carrot 
}
    yaml::yaml2dict $data
} -result {apple banana carrot}

test yaml.rb-2 "Nested Sequences" -body {
    set data {
---
- 
 - foo 
 - bar 
 - baz 
}
    yaml::yaml2dict $data
} -result {{foo bar baz}}

test yaml.rb-3 "Mixed Sequences" -body {
    set data {
---
-
 - fo o 
- 
 - x1 23 
- bana na
- carr ot
}
    yaml::yaml2dict $data
} -result {{{fo o}} {{x1 23}} {bana na} {carr ot}}

test yaml.rb-4 "Deeply Nested Sequences" -body {
    set data {
---
- 
 - 
  - uno 
  - dos 
}
    yaml::yaml2dict $data
} -result {{{uno dos}}}

test yaml.rb-5 "Simple Mapping" -body {
    set data {
---
foo: whatever 
bar: stuff 
}
    yaml::yaml2dict $data
} -result {foo whatever bar stuff}

test yaml.rb-6 "Sequence in a Mapping" -body {
    set data {
---
foo: whatever 
bar: 
 - uno 
 - dos 
}
    yaml::yaml2dict $data
} -result {foo whatever bar {uno dos}}

test yaml.rb-7 "Nested Mappings" -body {
    set data {
---
foo: whatever 
bar: 
 fruit: apple 
 name: steve 
 sport: baseball 
}
    yaml::yaml2dict $data
} -result [dict create foo whatever bar [dict create fruit apple name steve sport baseball]]

test yaml.rb-8 "Mixed Mapping" -body {
    set data {
---
foo: whatever 
bar: 
 - 
   fruit: apple 
   name: steve 
   sport: baseball 
 - more 
 - 
   python: rocks 
   perl: papers 
   ruby: scissorses 
}
    yaml::yaml2dict $data
} -result [dict create foo whatever bar [list [dict create fruit apple name steve sport baseball] more [dict create python rocks perl papers ruby scissorses]]]

test yaml.rb-9 "Mapping-in-Sequence Shortcut" -body {
    set data {
---
- work on YAML.py: 
   - work on Store
}
    yaml::yaml2dict $data
} -result {{{work on YAML.py} {{work on Store}}}}

test yaml.rb-10 "Sequence-in-Mapping Shortcut" -body {
    set data {
---
allow:
- 'localhost'
- '%.sourceforge.net'
- '%.freepan.org'
}
    yaml::yaml2dict $data
} -result {allow {localhost %.sourceforge.net %.freepan.org}}

test yaml.rb-11 "Merge key" -body {
    set data {
---
mapping:
  name: Joe
  job: Accountant
  <<:
    age: 38
}
    dictsort2 [yaml::yaml2dict $data] {d d}
} -result [dictsort2 {mapping {name Joe job Accountant age 38}} {d d}]

test yaml.rb-12 "Simple Inline Array" -body {
    set data {
---  
seq: [ a, b, c ] 
}
    yaml::yaml2dict $data
} -result {seq {a b c}}

test yaml.rb-13 "Simple Inline Hash" -body {
    set data {
---  
hash: { name: Steve, foo: bar }
}
    dictsort2 [yaml::yaml2dict $data] {d d}
} -result [dictsort2 {hash {name Steve foo bar}} {d d}]

test yaml.rb-14 "Multi-line Inline Collections" -body {
    set data {
---  
languages: [ Ruby, 
             Perl, 
             Python ] 
websites: { YAML: yaml.org, 
            Ruby: ruby-lang.org, 
            Python: python.org, 
            Perl: use.perl.org }
}
    dictsort2 [yaml::yaml2dict $data] {{d {websites d}}}
} -result [dictsort2 {languages {Ruby Perl Python} websites {YAML yaml.org Ruby ruby-lang.org Python python.org Perl use.perl.org}} \
{{d {websites d}}} ]

test yaml.rb-15 "Commas in Values" -body {
    set data {
---  
attendances: [ 45,123, 70,000, 17,222 ]
}
    yaml::yaml2dict $data
} -result {attendances {45 123 70 000 17 222}}

test yaml.rb-16 "Strings" -body {
    set data {
--- String
}
    yaml::yaml2dict $data
} -result {String}

test yaml.rb-17 "String characters" -body {
    set data {
---
- What's Yaml? 
- It's for writing data structures in plain text. 
- And? 
- And what? That's not good enough for you? 
- No, I mean, "And what about Yaml?" 
- Oh, oh yeah. Uh.. Yaml for Ruby. 
}
    yaml::yaml2dict $data
} -result {{What's Yaml?} {It's for writing data structures in plain text.} And? {And what? That's not good enough for you?} {No, I mean, "And what about Yaml?"} {Oh, oh yeah. Uh.. Yaml for Ruby.}}

test yaml.rb-18 "Indicators in Strings" -body {
    set data {
---  
the colon followed by space is an indicator: but is a string:right here 
same for the pound sign: here we have it#in a string 
the comma can, honestly, be used in most cases: [ but not in, inline collections ]
}
    yaml::yaml2dict $data
} -result [dict create {the colon followed by space is an indicator} {but is a string:right here} {same for the pound sign} {here we have it#in a string} {the comma can, honestly, be used in most cases} {{but not in} {inline collections}}]

test yaml.rb-19 "Forcing Strings" -body {
    set data {
---  
date string: !!str 2001-08-01 
number string: !!str 192 
}
    yaml::yaml2dict $data
} -result [dict create {date string} 2001-08-01 {number string} 192]

test yaml.rb-20 "Single-quoted Strings" -body {
    set data {
---  
all my favorite symbols: '#:!/%.)' 
a few i hate: '&(*' 
why do i hate them?: 'it''s very hard to explain' 
}
    yaml::yaml2dict $data
} -result {{all my favorite symbols} #:!/%.) {a few i hate} &(* {why do i hate them?} {it's very hard to explain}}

test yaml.rb-21 "Double-quoted Strings" -body {
    set data {
---  
i know where i want my line breaks: "one here\nand another here\n" 
}
    yaml::yaml2dict $data
} -result {{i know where i want my line breaks} {one here
and another here
}}

test yaml.rb-22 "Multi-line Quoted Strings" -body {
    set data {
---  
i want a long string: "so i'm going to
  let it go on and on to other lines
  until i end it with a quote."
}
    yaml::yaml2dict $data
} -result {{i want a long string} {so i'm going to let it go on and on to other lines until i end it with a quote.}}

test yaml.rb-23 "Plain scalars" -body {
    set data {
---  
- My little toe is broken in two places;
- I'm crazy to have skied this way;
- I'm not the craziest he's seen, since there was always the German guy
  who skied for 3 hours on a broken shin bone (just below the kneecap);
- Nevertheless, second place is respectable, and he doesn't
  recommend going for the record;
- He's going to put my foot in plaster for a month;
- This would impair my skiing ability somewhat for the
  duration, as can be imagined.
}
    yaml::yaml2dict $data
} -result {{My little toe is broken in two places;} {I'm crazy to have skied this way;} {I'm not the craziest he's seen, since there was always the German guy who skied for 3 hours on a broken shin bone (just below the kneecap);} {Nevertheless, second place is respectable, and he doesn't recommend going for the record;} {He's going to put my foot in plaster for a month;} {This would impair my skiing ability somewhat for the duration, as can be imagined.}}

test yaml.rb-24 "Null" -body {
    set data {
---  
name: Mr. Show 
hosted by: Bob and David 
date of next season: ~ 
}
    yaml::yaml2dict $data
} -result {name {Mr. Show} {hosted by} {Bob and David} {date of next season} {}}

test yaml.rb-25 "Boolean" -body {
    set data {
---  
Is Gus a Liar?: true
Do I rely on Gus for Sustenance?: false 
}
    yaml::yaml2dict $data
} -result [dict create {Is Gus a Liar?} 1 {Do I rely on Gus for Sustenance?} 0]

test yaml.rb-26 "Integers" -body {
    set data {
---  
zero: 0 
simple: 12 
one-thousand: 1,000 
negative one-thousand: -1,000 
}
    yaml::yaml2dict $data
} -result [dict create zero 0 simple 12 one-thousand 1000 {negative one-thousand} -1000]

test yaml.rb-27 "Integers as Map Keys" -body {
    set data {
---  
1: one 
2: two 
3: three 
}
    yaml::yaml2dict $data
} -result {1 one 2 two 3 three}

test yaml.rb-28 "Floats" -body {
    set data {
---  
a simple float: 2.00 
larger float: 1,000.09 
scientific notation: 1.00009e+3 
}
    yaml::yaml2dict $data
} -result [dict create {a simple float} 2.00 {larger float} 1000.09 {scientific notation} 1.00009e+3]


if {$::tcl_version < 8.5} {
    test yaml.rb-29 "Time" -body {
        set data {
---  
iso8601: 2001-12-14t21:59:43.10-05:00 
space seperated: 2001-12-14 21:59:43.10 -05:00 
}
        yaml::yaml2dict $data
    } -result [eval dict create [string map \
                 [list TIMESTAMP1 [clock scan "+5 hours" -base [clock scan "2001-12-14 21:59:43" -gmt 1]] \
                       TIMESTAMP2 [clock scan "+5 hours" -base [clock scan "2001-12-14 21:59:43" -gmt 1]]] \
                 {iso8601 TIMESTAMP1 {space seperated} TIMESTAMP2}]]
} else {
    test yaml.rb-29 "Time" -body {
        set data {
---  
iso8601: 2001-12-14t21:59:43.10-05:00 
space seperated: 2001-12-14 21:59:43.10 -05:00 
}
        yaml::yaml2dict $data
    } -result [string map [list TIMESTAMP1 [clock scan "2001-12-14 21:59:43 -05:00" -format {%Y-%m-%d %k:%M:%S %Z}] \
                                    TIMESTAMP2 [clock scan "2001-12-14 21:59:43 -05:00" -format {%Y-%m-%d %k:%M:%S %Z}]] \
                     {iso8601 TIMESTAMP1 {space seperated} TIMESTAMP2}]
}

test yaml.rb-30 "Date" -body {
    set data {
--- 1976-07-31
}
    yaml::yaml2dict $data
} -result [clock scan "1976-07-31"]

test yaml.rb-31 "Blocks" -body {
    set data {
---
this: |
    Foo
    Bar
}
    yaml::yaml2dict $data
} -result {this {Foo
Bar
}}

test yaml.rb-32 "The '+' indicator" -body {
    set data {
---
normal: |
  extra new lines not kept

preserving: |+
  extra new lines are kept


dummy: value
}
    dictsort [yaml::yaml2dict $data]
} -result [dictsort {normal {extra new lines not kept
} preserving {extra new lines are kept


} dummy value}]

test yaml.rb-33 "Three trailing newlines in literals" -body {
    set data {
---
clipped: |
    This has one newline.



same as "clipped" above: "This has one newline.\n"

stripped: |-
    This has no newline.



same as "stripped" above: "This has no newline."

kept: |+
    This has four newlines.



same as "kept" above: "This has four newlines.\n\n\n\n"
}
    dictsort [yaml::yaml2dict $data]
} -result [dictsort {clipped {This has one newline.
} {same as "clipped" above} {This has one newline.
} stripped {This has no newline.} {same as "stripped" above} {This has no newline.} kept {This has four newlines.



} {same as "kept" above} {This has four newlines.



}}]

test yaml.rb-34 "Extra trailing newlines with spaces" -body {
    set data {
---
this: |
    Foo


kept: |+
    Foo
}
    yaml::yaml2dict $data
} -result [dict create this {Foo
} kept {Foo
}]

test yaml.rb-35 "Folded Block in a Sequence" -body {
    set data {
---
- apple
- banana
- >
    can't you see
    the beauty of yaml?
    hmm
- dog
}
    yaml::yaml2dict $data
} -result {apple banana {can't you see the beauty of yaml? hmm
} dog}

test yaml.rb-36 "Folded Block as a Mapping Value" -body {
    set data {
---
quote: >
    Mark McGwire's
    year was crippled
    by a knee injury.
source: espn
}
    yaml::yaml2dict $data
} -result [dict create quote {Mark McGwire's year was crippled by a knee injury.
} source espn]

test yaml.rb-37 "Three trailing newlines in folded blocks" -body {
    set data {
---
clipped: >
    This has one newline.



same as "clipped" above: "This has one newline.\n" 

stripped: >-
    This has no newline.



same as "stripped" above: "This has no newline."

kept: >+
    This has four newlines.



same as "kept" above: "This has four newlines.\n\n\n\n"
}
    dictsort [yaml::yaml2dict $data]
} -result [dictsort {clipped {This has one newline.
} {same as "clipped" above} {This has one newline.
} stripped {This has no newline.} {same as "stripped" above} {This has no newline.} kept {This has four newlines.


} {same as "kept" above} {This has four newlines.



}}]

test yaml.rb-38 "Extra trailing newlines with spaces" -body {
    set data {
---
- &showell Steve 
- Clark 
- Brian 
- Oren 
- *showell
}
    yaml::yaml2dict $data
} -result {Steve Clark Brian Oren Steve}

test yaml.rb-39 "Alias of a Mapping" -body {
    set data {
---
- &hello 
    Meat: pork 
    Starch: potato 
- banana 
- *hello 
}
    yaml::yaml2dict $data
} -result [list [dict create Meat pork Starch potato] banana [dict create Meat pork Starch potato]]

#test yaml.rb-40 "Trailing Document Separator" -body {
#    set data {
#- foo: 1
#  bar: 2
#---
#more: stuff
#}
#    yaml::yaml2dict $data
#} -result {Steve Clark Brian Oren Steve}

test yaml.rb-41 "Alias of a Mapping" -body {
    set data {
--- %YAML:1.0 
foo: 1 
bar: 2 
}
    yaml::yaml2dict $data
} -result {foo 1 bar 2}

test yaml.rb-42 "Red Herring Document Separator" -body {
    set data {
---
foo: |
    ---
}
    yaml::yaml2dict $data
} -result {foo {---
}}

test yaml.rb-43 "Multiple Document Separators in Block" -body {
    set data {
---
foo: | 
    ---
    foo: bar
    ---
    yo: baz
bar: | 
    fooness
}
    yaml::yaml2dict $data
} -result {foo {---
foo: bar
---
yo: baz
} bar {fooness
}}

# YAML For Ruby
# (ignored)





# ... Tests of addStrings ...
#     (Requires introspection of parser state)


if [info exists selfrun] {
    tcltest::cleanupTests
} else {
    testsuiteCleanup
}