extra/yaml/yaml-tests.factor

   1 ! Copyright (C) 2014 Jon Harper.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs grouping kernel linked-assocs literals
   4 namespaces sequences tools.test yaml yaml.config yaml.ffi
   5 yaml.private calendar yaml.conversion ;
   6 IN: yaml.tests
   7
   8 ! TODO real conformance tests here
   9
  10 ! Config
  11 f implicit-tags set
  12 f implicit-start set
  13 f implicit-end set
  14 +libyaml-default+ emitter-canonical set
  15 +libyaml-default+ emitter-indent set
  16 +libyaml-default+ emitter-width set
  17 +libyaml-default+ emitter-line-break set
  18 t emitter-unicode set
  19
  20 ! Basic test
  21 CONSTANT: test-string "--- # Favorite movies
  22  - Casablanca
  23  - North by Northwest
  24  - The Man Who Wasn't There
  25  - last:
  26    - foo
  27    - bar
  28    - baz
  29 "
  30 CONSTANT: test-obj {
  31     "Casablanca"
  32     "North by Northwest"
  33     "The Man Who Wasn't There"
  34     H{ { "last" { "foo" "bar" "baz" } } }
  35 }
  36 CONSTANT: test-represented-string "--- !!seq
  37 - !!str Casablanca
  38 - !!str North by Northwest
  39 - !!str The Man Who Wasn't There
  40 - !!map
  41   !!str last: !!seq
  42   - !!str foo
  43   - !!str bar
  44   - !!str baz
  45 ...
  46 "
  47
  48 ${ test-obj } [ $ test-string yaml> ] unit-test
  49 ${ test-represented-string } [ $ test-obj >yaml ] unit-test
  50 ${ test-represented-string } [ $ test-represented-string yaml> >yaml ] unit-test
  51
  52 ! Non-scalar key
  53 CONSTANT: complex-key H{ { { "foo" } "bar" } }
  54 CONSTANT: complex-key-represented "--- !!map
  55 ? !!seq
  56 - !!str foo
  57 : !!str bar
  58 ...
  59 "
  60
  61 ${ complex-key } [ $ complex-key-represented yaml> ] unit-test
  62
  63 ! Multiple docs
  64 CONSTANT: test-docs "--- !!str a
  65 ...
  66 --- !!seq
  67 - !!str b
  68 - !!str c
  69 ...
  70 --- !!map
  71 !!str d: !!str e
  72 ...
  73 "
  74 CONSTANT: test-objs { "a" { "b" "c" } H{ { "d" "e" } } }
  75
  76 ${ test-objs } [ $ test-docs yaml-docs> ] unit-test
  77 ${ test-docs } [ $ test-objs >yaml-docs ] unit-test
  78 ${ test-docs } [ $ test-docs yaml-docs> >yaml-docs ] unit-test
  79
  80 ! Misc types
  81 CONSTANT: test-types { 1 t f 1.0 }
  82 CONSTANT: test-represented-types "--- !!seq
  83 - !!int 1
  84 - !!bool true
  85 - !!bool false
  86 - !!float 1.0
  87 ...
  88 "
  89
  90 ${ test-types } [ $ test-represented-types yaml> ] unit-test
  91 ${ test-types } [ $ test-types >yaml yaml> ] unit-test
  92
  93
  94 ! Anchors
  95 CONSTANT: test-anchors "- &1 \"1\"
  96 - *1
  97 - &2 [\"1\",\"2\"]
  98 - *2
  99 - &3
 100   *1 : \"one\"
 101 - *3
 102 "
 103 CONSTANT: test-anchors-obj {
 104   "1" "1" { "1" "2" } { "1" "2" } H{ { "1" "one" } } H{ { "1" "one" } }
 105 }
 106
 107 ${ test-anchors-obj } [ $ test-anchors yaml> ] unit-test
 108 ${ test-anchors-obj } [ $ test-anchors-obj >yaml yaml> ] unit-test
 109 ! and test indentity
 110 { t } [ $ test-anchors yaml> 2 group [ all-eq? ] all? ] unit-test
 111 { t } [ $ test-anchors yaml> >yaml yaml> 2 group [ all-eq? ] all? ] unit-test
 112
 113 ! Anchors and fancy types
 114 CONSTANT: fancy-anchors "- &1 [ \"foo\" ]
 115 - &2 !!set
 116   ? *1
 117 - *2
 118 "
 119 CONSTANT: fancy-anchors-obj {
 120   { "foo" } HS{ { "foo" } } HS{ { "foo" } }
 121 }
 122 ${ fancy-anchors-obj } [ $ fancy-anchors yaml> ] unit-test
 123 ${ fancy-anchors-obj } [ $ fancy-anchors-obj >yaml yaml> ] unit-test
 124
 125 ! Simple Recursive output
 126 : simple-recursive-list ( -- obj )
 127   { f } clone [ 0 over set-nth ] keep ;
 128 CONSTANT: simple-recursive-list-anchored T{ yaml-anchor f "0" {
 129   T{ yaml-alias f "0" }
 130 } }
 131 CONSTANT: simple-recursive-list-yaml "&0
 132 - *0"
 133
 134 ${ simple-recursive-list-anchored } [ simple-recursive-list replace-identities ] unit-test
 135 ${ simple-recursive-list-anchored } [ $ simple-recursive-list-yaml yaml> replace-identities ] unit-test
 136 ${ simple-recursive-list-anchored } [ simple-recursive-list >yaml yaml> replace-identities ] unit-test
 137
 138 ! many recursive outputs
 139 : many-recursive-objects ( -- obj )
 140   4 [ simple-recursive-list ] replicate ;
 141 CONSTANT: many-recursive-objects-anchored {
 142   T{ yaml-anchor f "0" { T{ yaml-alias f "0" } } }
 143   T{ yaml-anchor f "1" { T{ yaml-alias f "1" } } }
 144   T{ yaml-anchor f "2" { T{ yaml-alias f "2" } } }
 145   T{ yaml-anchor f "3" { T{ yaml-alias f "3" } } }
 146 }
 147
 148 ${ many-recursive-objects-anchored } [ many-recursive-objects replace-identities ] unit-test
 149
 150 ! Advanced recursive outputs
 151 :: transitive-recursive-objects ( -- obj )
 152   { f } :> list
 153   HS{ list } :> set
 154   H{ { set list } } :> hash
 155   hash 0 list set-nth
 156   list ;
 157 CONSTANT: transitive-recursive-objects-anchored T{ yaml-anchor f "0" {
 158   H{ { HS{ T{ yaml-alias f "0" } } T{ yaml-alias f "0" } } }
 159 } }
 160
 161 ${ transitive-recursive-objects-anchored } [ transitive-recursive-objects replace-identities ] unit-test
 162
 163
 164 ! Lifted from pyyaml
 165 ! http://pyyaml.org/browser/pyyaml/trunk/tests/data
 166
 167 ! !!!!!!!!!!!!!!!
 168 ! construct-bool
 169 ! TODO this is yaml 1.1, test it once a correct system
 170 ! for switching between 1.2 and 1.1 is available
 171 ! CONSTANT: construct-bool-obj H{
 172 !     { "canonical" t }
 173 !     { "answer" f }
 174 !     { "logical" t }
 175 !     { "option" t }
 176 !     { "but" H{ { "y" "is a string" } { "n" "is a string" } } }
 177 ! }
 178 !
 179 ! CONSTANT: construct-bool-str "canonical: yes
 180 ! answer: NO
 181 ! logical: True
 182 ! option: on
 183 !
 184 !
 185 ! but:
 186 !     y: is a string
 187 !     n: is a string
 188 ! "
 189 !
 190 ! ${ construct-bool-obj } [ $ construct-bool-str yaml> ] unit-test
 191 ! ${ construct-bool-obj } [ $ construct-bool-obj >yaml yaml> ] unit-test
 192
 193 ! !!!!!!!!!!!!!!!
 194 ! construct-int
 195 ! TODO _ in numbers is yaml 1.1, test it once a correct system
 196 ! for switching between 1.2 and 1.1 is available
 197 ! CONSTANT: construct-int-obj H{
 198 !     { "canonical" 685230 }
 199 !     { "decimal" 685230 }
 200 !     { "octal" 685230 }
 201 !     { "hexadecimal" 685230 }
 202 !     { "binary" 685230 }
 203 !     { "sexagesimal" 685230 }
 204 ! }
 205 ! CONSTANT: construct-int-str "canonical: 685230
 206 ! decimal: +685_230
 207 ! octal: 02472256
 208 ! hexadecimal: 0x_0A_74_AE
 209 ! binary: 0b1010_0111_0100_1010_1110
 210 ! sexagesimal: 190:20:30
 211 ! "
 212 !
 213 ! ${ construct-int-obj } [ $ construct-int-str yaml> ] unit-test
 214 ! ${ construct-int-obj } [ $ construct-int-obj >yaml yaml> ] unit-test
 215
 216 ! !!!!!!!!!!!!!!!
 217 ! construct-map
 218 CONSTANT: construct-map-obj H{ {
 219       "Block style"
 220       H{ { "Clark" "Evans" } { "Brian" "Ingerson" } { "Oren" "Ben-Kiki" } }
 221     } {
 222       "Flow style"
 223       H{ { "Clark" "Evans" } { "Brian" "Ingerson" } { "Oren" "Ben-Kiki" } }
 224     }
 225 }
 226
 227 CONSTANT: construct-map-str "# Unordered set of key: value pairs.
 228 Block style: !!map
 229   Clark : Evans
 230   Brian : Ingerson
 231   Oren  : Ben-Kiki
 232 Flow style: !!map { Clark: Evans, Brian: Ingerson, Oren: Ben-Kiki }
 233 "
 234
 235 ${ construct-map-obj } [ $ construct-map-str yaml> ] unit-test
 236 ${ construct-map-obj } [ $ construct-map-obj >yaml yaml> ] unit-test
 237
 238 ! !!!!!!!!!!!!!!!
 239 ! construct-null
 240 CONSTANT: construct-null-obj {
 241     f
 242     H{
 243         { "empty" f }
 244         { "canonical" f }
 245         { "english" f }
 246         { f "null key" }
 247     } H{
 248         {
 249           "sparse"
 250           { f "2nd entry" f "4th entry" f }
 251         }
 252     }
 253 }
 254
 255
 256 CONSTANT: construct-null-str "# A document may be null.
 257 ---
 258 ---
 259 # This mapping has four keys,
 260 # one has a value.
 261 empty:
 262 canonical: ~
 263 english: null
 264 ~: null key
 265 ---
 266 # This sequence has five
 267 # entries, two have values.
 268 sparse:
 269   - ~
 270   - 2nd entry
 271   -
 272   - 4th entry
 273   - Null
 274 "
 275
 276 ${ construct-null-obj } [ $ construct-null-str yaml-docs> ] unit-test
 277 ! TODO Decide what to do with null -> f -> false
 278 ! ${ construct-null-obj } [ $ construct-null-obj >yaml-docs yaml-docs> ] unit-test
 279
 280 ! !!!!!!!!!!!!!!!
 281 ! construct-seq
 282 CONSTANT: construct-seq-obj H{
 283     { "Block style" { "Mercury" "Venus" "Earth" "Mars" "Jupiter" "Saturn" "Uranus" "Neptune" "Pluto" } }
 284     { "Flow style" { "Mercury" "Venus" "Earth" "Mars" "Jupiter" "Saturn" "Uranus" "Neptune" "Pluto" } }
 285 }
 286
 287 CONSTANT: construct-seq-str "# Ordered sequence of nodes
 288 Block style: !!seq
 289 - Mercury   # Rotates - no light/dark sides.
 290 - Venus     # Deadliest. Aptly named.
 291 - Earth     # Mostly dirt.
 292 - Mars      # Seems empty.
 293 - Jupiter   # The king.
 294 - Saturn    # Pretty.
 295 - Uranus    # Where the sun hardly shines.
 296 - Neptune   # Boring. No rings.
 297 - Pluto     # You call this a planet?
 298 Flow style: !!seq [ Mercury, Venus, Earth, Mars,      # Rocks
 299                     Jupiter, Saturn, Uranus, Neptune, # Gas
 300                     Pluto ]                           # Overrated
 301 "
 302
 303 ${ construct-seq-obj } [ $ construct-seq-str yaml> ] unit-test
 304 ${ construct-seq-obj } [ $ construct-seq-obj >yaml yaml> ] unit-test
 305
 306 ! !!!!!!!!!!!!!!!
 307 ! construct-set
 308 CONSTANT: construct-set-obj H{
 309   {
 310    "baseball players" HS{
 311       "Mark McGwire"
 312       "Sammy Sosa"
 313       "Ken Griffey"
 314     }
 315   } {
 316     "baseball teams" HS{
 317       "Boston Red Sox"
 318       "Detroit Tigers"
 319       "New York Yankees"
 320     }
 321   }
 322 }
 323
 324 CONSTANT: construct-set-str "# Explicitly typed set.
 325 baseball players: !!set
 326   ? Mark McGwire
 327   ? Sammy Sosa
 328   ? Ken Griffey
 329 # Flow style
 330 baseball teams: !!set { Boston Red Sox, Detroit Tigers, New York Yankees }
 331 "
 332
 333 ${ construct-set-obj } [ $ construct-set-str yaml> ] unit-test
 334 ${ construct-set-obj } [ $ construct-set-obj >yaml yaml> ] unit-test
 335
 336 ! !!!!!!!!!!!!!!!
 337 ! construct-binary
 338
 339 ! # byte-arrays contents generate by the following python script
 340 ! # which uses the string from pyyaml tests
 341 ! from __future__ import print_function
 342 ! l=0
 343 ! for char in "GIF89a\x0c\x00\x0c\x00\x84\x00\x00\xff\xff\xf7\xf5\xf5\xee\xe9\xe9\xe5fff\x00\x00\x00\xe7\xe7\xe7^^^\xf3\xf3\xed\x8e\x8e\x8e\xe0\xe0\xe0\x9f\x9f\x9f\x93\x93\x93\xa7\xa7\xa7\x9e\x9e\x9eiiiccc\xa3\xa3\xa3\x84\x84\x84\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9\xff\xfe\xf9!\xfe\x0eMade with GIMP\x00,\x00\x00\x00\x00\x0c\x00\x0c\x00\x00\x05,  \x8e\x810\x9e\xe3@\x14\xe8i\x10\xc4\xd1\x8a\x08\x1c\xcf\x80M$z\xef\xff0\x85p\xb8\xb01f\r\x1b\xce\x01\xc3\x01\x1e\x10' \x82\n\x01\x00;":
 344 !     s = str(ord(char))
 345 !     print(s, end='')
 346 !     l=l+len(s)+1
 347 !     if (l >= 60):
 348 !         print("\n", end='')
 349 !         l = 0
 350 !     else:
 351 !         print(' ', end='')
 352 ! print("\n", end='')
 353 CONSTANT: construct-binary-obj H{
 354   {
 355    "canonical" B{
 356       71 73 70 56 57 97 12 0 12 0 132 0 0 255 255 247 245 245 238
 357       233 233 229 102 102 102 0 0 0 231 231 231 94 94 94 243 243 237
 358       142 142 142 224 224 224 159 159 159 147 147 147 167 167 167
 359       158 158 158 105 105 105 99 99 99 163 163 163 132 132 132 255
 360       254 249 255 254 249 255 254 249 255 254 249 255 254 249 255
 361       254 249 255 254 249 255 254 249 255 254 249 255 254 249 255
 362       254 249 255 254 249 255 254 249 255 254 249 33 254 14 77 97
 363       100 101 32 119 105 116 104 32 71 73 77 80 0 44 0 0 0 0 12 0
 364       12 0 0 5 44 32 32 142 129 48 158 227 64 20 232 105 16 196 209
 365       138 8 28 207 128 77 36 122 239 255 48 133 112 184 176 49 102
 366       13 27 206 1 195 1 30 16 39 32 130 10 1 0 59
 367     }
 368   } {
 369    "generic" B{
 370       71 73 70 56 57 97 12 0 12 0 132 0 0 255 255 247 245 245 238
 371       233 233 229 102 102 102 0 0 0 231 231 231 94 94 94 243 243 237
 372       142 142 142 224 224 224 159 159 159 147 147 147 167 167 167
 373       158 158 158 105 105 105 99 99 99 163 163 163 132 132 132 255
 374       254 249 255 254 249 255 254 249 255 254 249 255 254 249 255
 375       254 249 255 254 249 255 254 249 255 254 249 255 254 249 255
 376       254 249 255 254 249 255 254 249 255 254 249 33 254 14 77 97
 377       100 101 32 119 105 116 104 32 71 73 77 80 0 44 0 0 0 0 12 0
 378       12 0 0 5 44 32 32 142 129 48 158 227 64 20 232 105 16 196 209
 379       138 8 28 207 128 77 36 122 239 255 48 133 112 184 176 49 102
 380       13 27 206 1 195 1 30 16 39 32 130 10 1 0 59
 381     }
 382   } {
 383     "description" "The binary value above is a tiny arrow encoded as a gif image."
 384   }
 385 }
 386
 387 CONSTANT: construct-binary-str "canonical: !!binary \"\\
 388  R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5\\
 389  OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+\\
 390  +f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC\\
 391  AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs=\"
 392 generic: !!binary |
 393  R0lGODlhDAAMAIQAAP//9/X17unp5WZmZgAAAOfn515eXvPz7Y6OjuDg4J+fn5
 394  OTk6enp56enmlpaWNjY6Ojo4SEhP/++f/++f/++f/++f/++f/++f/++f/++f/+
 395  +f/++f/++f/++f/++f/++SH+Dk1hZGUgd2l0aCBHSU1QACwAAAAADAAMAAAFLC
 396  AgjoEwnuNAFOhpEMTRiggcz4BNJHrv/zCFcLiwMWYNG84BwwEeECcgggoBADs=
 397 description:
 398  The binary value above is a tiny arrow encoded as a gif image.
 399 "
 400
 401 ${ construct-binary-obj } [ $ construct-binary-str yaml> ] unit-test
 402 ${ construct-binary-obj } [ $ construct-binary-obj >yaml yaml> ] unit-test
 403
 404 ! !!!!!!!!!!!!!!!
 405 ! construct-merge
 406 CONSTANT: construct-merge-obj {
 407     H{ { "x" 1 } { "y" 2 } }
 408     H{ { "x" 0 } { "y" 2 } }
 409     H{ { "r" 10 } }
 410     H{ { "r" 1 } }
 411     H{ { "x" 1 } { "y" 2 } { "r" 10 } { "label" "center/big" } }
 412     H{ { "x" 1 } { "y" 2 } { "r" 10 } { "label" "center/big" } }
 413     H{ { "x" 1 } { "y" 2 } { "r" 10 } { "label" "center/big" } }
 414     H{ { "x" 1 } { "y" 2 } { "r" 10 } { "label" "center/big" } }
 415 }
 416
 417 :: construct-merge-obj2 ( -- obj )
 418     H{ { "x" 1 } { "y" 2 } } :> CENTER
 419     H{ { "x" 0 } { "y" 2 } } :> LEFT
 420     H{ { "r" 10 } } :> BIG
 421     H{ { "r" 1 } } :> SMALL
 422  {
 423     CENTER
 424     LEFT
 425     BIG
 426     SMALL
 427     H{ { "x" 1 } { "y" 2 } { "r" 10 } { "label" "center/big" } }
 428     H{ { T{ yaml-merge } CENTER }  { "r" 10 } { "label" "center/big" } }
 429     H{ { T{ yaml-merge } { CENTER BIG } } { "label" "center/big" } }
 430     H{ { T{ yaml-merge } { BIG LEFT SMALL } } { "x" 1 } { "label" "center/big" } }
 431 } ;
 432
 433 CONSTANT: construct-merge-str "---
 434 - &CENTER { x: 1, 'y': 2 }
 435 - &LEFT { x: 0, 'y': 2 }
 436 - &BIG { r: 10 }
 437 - &SMALL { r: 1 }
 438
 439 # All the following maps are equal:
 440
 441 - # Explicit keys
 442   x: 1
 443   'y': 2
 444   r: 10
 445   label: center/big
 446
 447 - # Merge one map
 448   << : *CENTER
 449   r: 10
 450   label: center/big
 451
 452 - # Merge multiple maps
 453   << : [ *CENTER, *BIG ]
 454   label: center/big
 455
 456 - # Override
 457   << : [ *BIG, *LEFT, *SMALL ]
 458   x: 1
 459   label: center/big
 460 "
 461
 462 ${ construct-merge-obj } [ $ construct-merge-str yaml> ] unit-test
 463 ${ construct-merge-obj } [ $ construct-merge-obj2 >yaml yaml> ] unit-test
 464
 465 ! More merge tests
 466 ! see http://sourceforge.net/p/yaml/mailman/message/12308050
 467 CONSTANT: nested-merge-str "foo: 1
 468 <<:
 469   bar: 2
 470   <<:
 471     baz: 3"
 472 CONSTANT: nested-merge-obj H{
 473   { "foo" 1 }
 474   { "bar" 2 }
 475   { "baz" 3 }
 476 }
 477
 478 ${ nested-merge-obj } [ $ nested-merge-str yaml> ] unit-test
 479 ${ nested-merge-obj } [ $ nested-merge-obj >yaml yaml> ] unit-test
 480
 481 CONSTANT: recursive-merge-str "--- &A
 482 <<: *A"
 483 CONSTANT: recursive-merge-obj H{ }
 484
 485 ${ recursive-merge-obj } [ $ recursive-merge-str yaml> ] unit-test
 486 ${ recursive-merge-obj } [ $ recursive-merge-obj >yaml yaml> ] unit-test
 487
 488 ! Compare with pyyaml
 489 ! >>> print yaml.load("&1 {1: 2, 2: 3, 3: {4: 5, <<: *1}}")
 490 ! {1: 2, 2: 3, 3: {1: 2, 2: 3, 3: {...}, 4: 5}}
 491 ! >>> print yaml.load("&1 {1: 2, 2: 3, 3: {3: 100, 4: 5, <<: *1}}")
 492 ! {1: 2, 2: 3, 3: {1: 2, 2: 3, 3: 100, 4: 5}}
 493 CONSTANT: recursive-merge-str2 "&1 {1: 2, 2: 3, 3: {4: 5, <<: *1}}"
 494 CONSTANT: recursive-merge-str3 "&1 {1: 2, 2: 3, 3: {3: 100, 4: 5, <<: *1}}"
 495 :: recursive-merge-obj2 ( -- obj ) H{ } clone :> inner
 496   inner H{
 497   { 1 2 }
 498   { 2 3 }
 499   { 3 inner }
 500   { 4 5 }
 501 } assoc-union! drop
 502   H{
 503     { 1 2 }
 504     { 2 3 }
 505     { 3 inner }
 506   } ;
 507 CONSTANT: recursive-merge-obj3 H{
 508   { 1 2 }
 509   { 2 3 }
 510   { 3 H{ { 1 2 } { 2 3 } { 3 100 } { 4 5 } } }
 511 }
 512
 513 { t } [
 514   $ recursive-merge-str2 yaml> recursive-merge-obj2
 515   [ replace-identities ] bi@ =
 516 ] unit-test
 517 { t } [
 518   recursive-merge-obj2 >yaml yaml> recursive-merge-obj2
 519   [ replace-identities ] bi@ =
 520 ] unit-test
 521 ${ recursive-merge-obj3 } [ $ recursive-merge-str3 yaml> ] unit-test
 522 ${ recursive-merge-obj3 } [ $ recursive-merge-obj3 >yaml yaml> ] unit-test
 523
 524 ! Serializing merge
 525 CONSTANT: serialize-merge-obj H{
 526   { T{ yaml-merge } H{ { 1 2 } } }
 527 }
 528 CONSTANT: serialize-merge-obj2 H{ { 1 2 } }
 529 ${ serialize-merge-obj2 } [ $ serialize-merge-obj >yaml yaml> ] unit-test
 530 f merge [
 531   ${ serialize-merge-obj } [ $ serialize-merge-obj >yaml yaml> ] unit-test
 532 ] with-variable
 533
 534 ! !!!!!!!!!!!!!!!
 535 ! construct-omap
 536 CONSTANT: construct-omap-obj H{
 537   {
 538     "Bestiary"
 539     $[ <linked-hash> {
 540         { "aardvark" "African pig-like ant eater. Ugly." }
 541         { "anteater" "South-American ant eater. Two species." }
 542         { "anaconda" "South-American constrictor snake. Scaly." }
 543     } assoc-union! ]
 544   } {
 545     "Numbers"
 546     $[ <linked-hash> {
 547         { "one" 1 }
 548         { "two" 2 }
 549         { "three" 3 }
 550     } assoc-union! ]
 551   }
 552 }
 553
 554 CONSTANT: construct-omap-str "# Explicitly typed ordered map (dictionary).
 555 Bestiary: !!omap
 556   - aardvark: African pig-like ant eater. Ugly.
 557   - anteater: South-American ant eater. Two species.
 558   - anaconda: South-American constrictor snake. Scaly.
 559   # Etc.
 560 # Flow style
 561 Numbers: !!omap [ one: 1, two: 2, three : 3 ]
 562 "
 563
 564 ${ construct-omap-obj } [ $ construct-omap-str yaml> ] unit-test
 565 ${ construct-omap-obj } [ construct-omap-obj >yaml yaml> ] unit-test
 566
 567 ! !!!!!!!!!!!!!!!
 568 ! construct-pairs
 569 CONSTANT: construct-pairs-obj H{
 570   {
 571     "Block tasks" {
 572       { "meeting" "with team." }
 573       { "meeting" "with boss." }
 574       { "break" "lunch." }
 575       { "meeting" "with client." }
 576     }
 577   } {
 578     "Flow tasks" {
 579       { "meeting" "with team" } { "meeting" "with boss" }
 580     }
 581   }
 582 }
 583
 584 CONSTANT: construct-pairs-str "# Explicitly typed pairs.
 585 Block tasks: !!pairs
 586   - meeting: with team.
 587   - meeting: with boss.
 588   - break: lunch.
 589   - meeting: with client.
 590 Flow tasks: !!pairs [ meeting: with team, meeting: with boss ]
 591 "
 592
 593 CONSTANT: construct-pairs-obj-roundtripped H{
 594   {
 595     "Block tasks" {
 596       H{ { "meeting" "with team." } }
 597       H{ { "meeting" "with boss." } }
 598       H{ { "break" "lunch." } }
 599       H{ { "meeting" "with client." } }
 600     }
 601   } {
 602     "Flow tasks" {
 603       H{ { "meeting" "with team" } } H{ { "meeting" "with boss" } }
 604     }
 605   }
 606 }
 607
 608 ${ construct-pairs-obj } [ $ construct-pairs-str yaml> ] unit-test
 609 ${ construct-pairs-obj } [ $ construct-pairs-obj >yaml yaml> ] unit-test
 610
 611 ! !!!!!!!!!!!!!!!
 612 ! construct-timestamp
 613 CONSTANT: construct-timestamp-obj H{
 614     {
 615         "space separated"
 616         T{ timestamp
 617             { year 2001 }
 618             { month 12 }
 619             { day 14 }
 620             { hour 21 }
 621             { minute 59 }
 622             { second 43+1/10 }
 623             { gmt-offset T{ duration { hour -5 } } }
 624         }
 625     }
 626     {
 627         "canonical"
 628         T{ timestamp
 629             { year 2001 }
 630             { month 12 }
 631             { day 15 }
 632             { hour 2 }
 633             { minute 59 }
 634             { second 43+1/10 }
 635         }
 636     }
 637     {
 638         "date (00:00:00Z)"
 639         T{ timestamp { year 2002 } { month 12 } { day 14 } }
 640     }
 641     {
 642         "no time zone (Z)"
 643         T{ timestamp
 644             { year 2001 }
 645             { month 12 }
 646             { day 15 }
 647             { hour 2 }
 648             { minute 59 }
 649             { second 43+1/10 }
 650         }
 651     }
 652     {
 653         "valid iso8601"
 654         T{ timestamp
 655             { year 2001 }
 656             { month 12 }
 657             { day 14 }
 658             { hour 21 }
 659             { minute 59 }
 660             { second 43+1/10 }
 661             { gmt-offset T{ duration { hour -5 } } }
 662         }
 663     }
 664     {
 665         "crazy"
 666         T{ timestamp
 667             { year 2002 }
 668             { month 2 }
 669             { day 4 }
 670             { hour 1 }
 671             { minute 2 }
 672             { second 59+123/1000 }
 673             { gmt-offset
 674                 T{ duration { hour 10 } { minute 23 } }
 675             }
 676         }
 677     }
 678 }
 679 CONSTANT: construct-timestamp-str "canonical:        2001-12-15T02:59:43.1Z
 680 valid iso8601:    2001-12-14t21:59:43.10-05:00
 681 space separated:  2001-12-14 21:59:43.10 -5
 682 no time zone (Z): 2001-12-15 2:59:43.10
 683 date (00:00:00Z): 2002-12-14
 684 crazy: 2002-2-4   \t\t \t 1:02:59.123 \t\t +10:23
 685 "
 686
 687 ${ construct-timestamp-obj } [ $ construct-timestamp-str yaml> ] unit-test
 688 ${ construct-timestamp-obj } [ $ construct-timestamp-obj >yaml yaml> ] unit-test
 689
 690 ! !!!!!!!!!!!!!!!
 691 ! construct-value
 692 CONSTANT: construct-value-unsafe-obj {
 693     H{ { "link with" { "library1.dll" "library2.dll" } } }
 694     H{ {
 695         "link with" {
 696             H{ { T{ yaml-value } "library1.dll" } { "version" 1.2 } }
 697             H{ { T{ yaml-value } "library2.dll" } { "version" 2.3 } }
 698         }
 699     } }
 700 }
 701 CONSTANT: construct-value-safe-obj {
 702     H{ { "link with" { "library1.dll" "library2.dll" } } }
 703     H{ { "link with" { "library1.dll" "library2.dll" } } }
 704 }
 705
 706 CONSTANT: construct-value-str "---     # Old schema
 707 link with:
 708   - library1.dll
 709   - library2.dll
 710 ---     # New schema
 711 link with:
 712   - = : library1.dll
 713     version: 1.2
 714   - = : library2.dll
 715     version: 2.3
 716 "
 717
 718 ${ construct-value-safe-obj } [ $ construct-value-str yaml-docs> ] unit-test
 719 ${ construct-value-safe-obj } [ $ construct-value-safe-obj >yaml-docs yaml-docs> ] unit-test
 720 f value [
 721   ${ construct-value-unsafe-obj } [ $ construct-value-str yaml-docs> ] unit-test
 722   ${ construct-value-unsafe-obj } [ $ construct-value-unsafe-obj >yaml-docs yaml-docs> ] unit-test
 723   ${ construct-value-safe-obj } [
 724     $ construct-value-str yaml-docs> [
 725      dup "link with" swap [ [ scalar-value ] map ] change-at
 726     ] map
 727   ] unit-test
 728 ] with-variable
 729
 730 ! Serializing value
 731 CONSTANT: serialize-value-obj H{
 732   { T{ yaml-value } 1 }
 733 }
 734 CONSTANT: serialize-value-obj2 1
 735 ${ serialize-value-obj2 } [ $ serialize-value-obj >yaml yaml> ] unit-test
 736 f value [
 737   ${ serialize-value-obj } [ $ serialize-value-obj >yaml yaml> ] unit-test
 738 ] with-variable
 739
 740 ! !!!!!!!!!!!!!!!
 741 ! errors
 742
 743 [ "- foo\n:)" yaml> ] [ libyaml-parser-error? ] must-fail-with
 744 [ "- &foo 1\n- *baz\n" yaml> ] [ yaml-undefined-anchor? ] must-fail-with
 745 [ "" yaml> ] [ yaml-no-document? ] must-fail-with
 746
 747
 748 ! !!!!!!!!!!!!!!!
 749 ! misc
 750
 751 ! Don't use aliases/anchors for equal fixnums
 752 { f } [ CHAR: & { 0 0 } >yaml member? ] unit-test
 753
 754 ! !!!!!!!!!!!!!!!
 755 ! Config
 756 t implicit-tags set
 757 t implicit-start set
 758 t implicit-end set
 759
 760 ! unicode on
 761   t emitter-unicode
 762 [
 763 { "- Hello
 764 - Grüß dich
 765 - здравствуйте
 766 - こんにちは
 767 - 안녕하세요
 768 - 'שָׁלוֹם '
 769 - გამარჯობა
 770 " } [ { "Hello" "Grüß dich" "здравствуйте" "こんにちは" "안녕하세요" "שָׁלוֹם " "გამარჯობა" } >yaml ] unit-test
 771 ] with-variable
 772
 773 ! unicode off
 774 f emitter-unicode
 775 [
 776 { "- Hello
 777 - \"Gr\\xFC\\xDF dich\"
 778 - \"\\u0437\\u0434\\u0440\\u0430\\u0432\\u0441\\u0442\\u0432\\u0443\\u0439\\u0442\\u0435\"
 779 - \"\\u3053\\u3093\\u306B\\u3061\\u306F\"
 780 - \"\\uC548\\uB155\\uD558\\uC138\\uC694\"
 781 - \"\\u05E9\\u05B8\\u05C1\\u05DC\\u05D5\\u05B9\\u05DD \"
 782 - \"\\u10D2\\u10D0\\u10DB\\u10D0\\u10E0\\u10EF\\u10DD\\u10D1\\u10D0\"
 783 " } [ { "Hello" "Grüß dich" "здравствуйте" "こんにちは" "안녕하세요" "שָׁלוֹם " "გამარჯობა" } >yaml ] unit-test
 784 ] with-variable
 785
 786 ! canonical
 787 t emitter-canonical [
 788 { "---
 789 !!seq [
 790   !!int \"1\",
 791   !!float \"2.0\",
 792   !!bool \"false\",
 793 ]
 794 " } [ { 1 2.0 f } >yaml ] unit-test
 795 ] with-variable
 796
 797 {
 798   { emitter-indent 6 }
 799   { emitter-width 32 }
 800 }
 801 [
 802 { "-     - a string that can be split
 803             in lots of places
 804 "
 805  } [ { { "a string that can be split in lots of places" } } >yaml ] unit-test
 806 ] with-variables
 807
 808 ! line break
 809 YAML_LN_BREAK emitter-line-break [
 810 { "- foo\n" } [ { "foo" } >yaml ] unit-test
 811 ] with-variable
 812
 813 YAML_CR_BREAK emitter-line-break [
 814 { "- foo\r" } [ { "foo" } >yaml ] unit-test
 815 ] with-variable
 816
 817 YAML_CRLN_BREAK emitter-line-break [
 818 { "- foo\r\n" } [ { "foo" } >yaml ] unit-test
 819 ] with-variable