2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: arrays assocs combinators combinators.short-circuit
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								grouping io.encodings.utf8 io.files io.streams.null kernel
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								locals math math.parser quotations random sequences splitting
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								splitting.extras strings tools.test unicode
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								unicode.normalize.private ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-25 13:40:12 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: unicode.normalize.tests
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-09 18:13:26 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "ab\u000323\u000302cd" } [ "ab\u000302" "\u000323cd" string-append ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-09 18:13:26 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "ab\u00064b\u000347\u00034e\u00034d\u000346" }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "ab\u000346\u000347\u00064b\u00034e\u00034d" dup reorder ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "hello" "hello" } [ "hello" [ nfd ] keep nfkd ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "\u00FB012\u002075\u00017F\u000323\u000307" "fi25s\u000323\u000307" }
							 | 
						
					
						
							
								
									
										
										
										
											2008-02-01 16:00:02 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ "\u00FB012\u002075\u001E9B\u000323" [ nfd ] keep nfkd ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-09 18:13:26 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ "\u001E69" "s\u000323\u000307" } [ "\u001E69" [ nfc ] keep nfd ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ "\u001E0D\u000307" } [ "\u001E0B\u000323" nfc ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2008-01-09 18:13:26 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-03 12:39:59 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ 54620 } [ 4370 4449 4523 jamo>hangul ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ 4370 4449 4523 } [ 54620 hangul>jamo first3 ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ t } [ 54620 hangul? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ f } [ 0 hangul? ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ "\u001112\u001161\u0011ab" } [ "\u00d55c" nfd ] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ "\u00d55c" } [ "\u001112\u001161\u0011ab" nfc ] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-25 13:40:12 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								! Could use simple-flat-file after some cleanup
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: parse-normalization-tests ( -- tests )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "vocab:unicode/UCD/NormalizationTest.txt" utf8 file-lines
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ "#" head? ] reject
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ "@" head? ] split*-when
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    2 <groups> [ first2 [ first ] dip 2array ] map
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    values [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            "#@" split first [ CHAR: \s = ] trim-tail ";" split harvest
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ " " split [ hex> ] "" map-as ] map
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] map
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] map concat ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								:: check-normalization-test? ( test spec quot -- ? )
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-25 13:40:12 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    spec [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [
							 | 
						
					
						
							
								
									
										
										
										
											2016-07-10 19:54:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            [ 1 - test nth ] bi@ quot call( str -- str' ) =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        ] with all?
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] assoc-all? ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-05-25 13:40:12 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								{ { } } [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    parse-normalization-tests [
							 | 
						
					
						
							
								
									
										
										
										
											2016-07-10 19:54:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        {
							 | 
						
					
						
							
								
									
										
										
										
											2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								            [ { { 2 { 1 2 3 } } { 4 { 4 5 } } } [ nfc ] check-normalization-test? ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ { { 3 { 1 2 3 } } { 5 { 4 5 } } } [ nfd ] check-normalization-test? ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ { { 4 { 1 2 3 4 5 } } } [ nfkc ] check-normalization-test? ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								            [ { { 5 { 1 2 3 4 5 } } } [ nfkd ] check-normalization-test? ]
							 | 
						
					
						
							
								
									
										
										
										
											2016-07-10 19:54:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        } 1&&
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] reject
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2019-06-22 10:47:07 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								{ { 4018 820 3953 3968 } }
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ { 3958 3953 820 } >string nfd >array ] unit-test
							 |