2012-07-26 11:01:57 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors arrays bootstrap.image continuations
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.directories io.files.info io.files.temp io.launcher
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								io.backend kernel layouts math sequences system
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-14 02:00:54 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								tools.deploy.backend tools.deploy.config.editor ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: tools.deploy.test
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2012-07-26 11:01:57 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: test-image ( -- str )
							 | 
						
					
						
							
								
									
										
										
										
											2015-08-12 12:08:24 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    my-arch-name "test." ".image" surround ;
							 | 
						
					
						
							
								
									
										
										
										
											2012-07-26 11:01:57 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-30 18:13:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: test-image-path ( -- str )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    test-image temp-file ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-14 02:00:54 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: shake-and-bake ( vocab -- )
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-30 18:13:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ test-image-path delete-file ] ignore-errors
							 | 
						
					
						
							
								
									
										
										
										
											2014-04-22 23:44:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-20 03:03:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ vm-path test-image temp-file ] dip
							 | 
						
					
						
							
								
									
										
										
										
											2010-02-15 02:10:05 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        dup deploy-config make-deploy-image drop
							 | 
						
					
						
							
								
									
										
										
										
											2014-04-22 23:44:04 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] with-resource-directory ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-14 02:00:54 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-11-14 03:01:23 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								ERROR: image-too-big actual-size max-size ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: small-enough? ( n -- )
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-30 18:13:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ test-image-path file-info size>> ]
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-12 14:24:45 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        cell 4 / *
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								        cpu ppc? [ 100000 + ] when
							 | 
						
					
						
							
								
									
										
										
										
											2013-07-16 14:26:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        os windows? [ 160000 + ] when
							 | 
						
					
						
							
								
									
										
										
										
											2009-09-12 14:24:45 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    ] bi*
							 | 
						
					
						
							
								
									
										
										
										
											2015-08-13 19:13:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    2dup <= [ 2drop ] [ image-too-big ] if ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-01-14 02:00:54 -05:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-02 22:00:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: deploy-test-command ( -- args )
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-12 06:16:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    os macosx?
							 | 
						
					
						
							
								
									
										
										
										
											2015-07-20 03:03:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "resource:Factor.app/Contents/MacOS/factor" normalize-path vm-path ?
							 | 
						
					
						
							
								
									
										
										
										
											2016-03-30 18:13:14 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "-i=" test-image-path append 2array ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-02 22:00:12 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: run-temp-image ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-19 07:11:00 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    deploy-test-command try-output-process ;
							 |