modules/yaml/rb.test

#
# 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
}