derivations: Add 'offloadable-derivation?' and 'substitutable-derivation?'.
* guix/derivations.scm (offloadable-derivation?,
  substitutable-derivation?): New procedures.
* tests/derivations.scm ("offloadable-derivation?"): New test.
			
			
This commit is contained in:
		
							parent
							
								
									31a123fe00
								
							
						
					
					
						commit
						fc93e30919
					
				
					 2 changed files with 20 additions and 0 deletions
				
			
		| 
						 | 
					@ -57,6 +57,8 @@
 | 
				
			||||||
            derivation-input-output-paths
 | 
					            derivation-input-output-paths
 | 
				
			||||||
 | 
					
 | 
				
			||||||
            fixed-output-derivation?
 | 
					            fixed-output-derivation?
 | 
				
			||||||
 | 
					            offloadable-derivation?
 | 
				
			||||||
 | 
					            substitutable-derivation?
 | 
				
			||||||
            derivation-hash
 | 
					            derivation-hash
 | 
				
			||||||
 | 
					
 | 
				
			||||||
            read-derivation
 | 
					            read-derivation
 | 
				
			||||||
| 
						 | 
					@ -156,6 +158,18 @@ download with a fixed hash (aka. `fetchurl')."
 | 
				
			||||||
                     read-derivation))
 | 
					                     read-derivation))
 | 
				
			||||||
                 inputs)))))
 | 
					                 inputs)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (offloadable-derivation? drv)
 | 
				
			||||||
 | 
					  "Return true if DRV can be offloaded, false otherwise."
 | 
				
			||||||
 | 
					  (match (assoc "preferLocalBuild"
 | 
				
			||||||
 | 
					                (derivation-builder-environment-vars drv))
 | 
				
			||||||
 | 
					    (("preferLocalBuild" . "1") #f)
 | 
				
			||||||
 | 
					    (_ #t)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define substitutable-derivation?
 | 
				
			||||||
 | 
					  ;; Return #t if the derivation can be substituted.  Currently the two are
 | 
				
			||||||
 | 
					  ;; synonymous, see <http://bugs.gnu.org/18747>.
 | 
				
			||||||
 | 
					  offloadable-derivation?)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define* (derivation-prerequisites-to-build store drv
 | 
					(define* (derivation-prerequisites-to-build store drv
 | 
				
			||||||
                                            #:key
 | 
					                                            #:key
 | 
				
			||||||
                                            (outputs
 | 
					                                            (outputs
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -173,6 +173,12 @@
 | 
				
			||||||
                (= (stat:ino (lstat file1))
 | 
					                (= (stat:ino (lstat file1))
 | 
				
			||||||
                   (stat:ino (lstat file2))))))))
 | 
					                   (stat:ino (lstat file2))))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(test-assert "offloadable-derivation?"
 | 
				
			||||||
 | 
					  (and (offloadable-derivation? (derivation %store "foo" %bash '()))
 | 
				
			||||||
 | 
					       (not (offloadable-derivation?
 | 
				
			||||||
 | 
					             (derivation %store "foo" %bash '()
 | 
				
			||||||
 | 
					                         #:local-build? #t)))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(test-assert "fixed-output-derivation?"
 | 
					(test-assert "fixed-output-derivation?"
 | 
				
			||||||
  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 | 
					  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
 | 
				
			||||||
                                        "echo -n hello > $out" '()))
 | 
					                                        "echo -n hello > $out" '()))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue