2008-08-29 05:23:39 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: io.encodings.ascii sequences strings io io.files accessors
							 | 
						
					
						
							
								
									
										
										
										
											2008-12-14 22:21:44 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								tools.test kernel io.files.unique namespaces continuations
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-26 21:17:02 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								io.files.info io.pathnames io.directories ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-22 23:07:59 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: io.files.unique.tests
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ 123 ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    "core" ".test" [
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-20 04:26:56 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ [ 123 CHAR: a <string> ] dip ascii set-file-contents ]
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-28 17:14:55 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        [ file-info size>> ] bi
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-26 16:05:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] cleanup-unique-file
							 | 
						
					
						
							
								
									
										
										
										
											2008-08-22 23:07:59 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-28 17:14:55 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ t ] [
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-26 16:05:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ current-directory get file-info directory? ] cleanup-unique-directory
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-28 17:14:55 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ t ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    current-directory get
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-26 16:05:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ "FAILDOG" throw ] cleanup-unique-directory ] [ drop ] recover
							 | 
						
					
						
							
								
									
										
										
										
											2008-11-28 17:14:55 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    current-directory get =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-26 16:05:15 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ t ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "asdf" unique-file drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "asdf2" unique-file drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        current-temporary-directory get directory-files length 2 =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] cleanup-unique-directory
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ t ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ ] with-unique-directory >boolean
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								[ t ] [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "asdf" unique-file drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        "asdf" unique-file drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        current-temporary-directory get directory-files length 2 =
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] with-unique-directory drop
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								] unit-test
							 |