Commit b4b3dab8 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Merge branch 'master' into minimakefile

parents 59df9898 5832e586
......@@ -75,7 +75,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "3.1.5" ;; to be automatically updated by make bump-version
:version "3.1.5.5" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
:class #+asdf3.1 package-inferred-system #-asdf3.1 system
......
......@@ -503,12 +503,12 @@ itself.")) ;; operation on a system and its dependencies
`(,(make-library-system
"cmp" (compiler-library-pathname))))
,@(unless (or (no-uiop c) (has-it-p "uiop") (has-it-p "asdf"))
`(cond
((system-source-directory :uiop) `(,(find-system :uiop)))
((system-source-directory :asdf) `(,(find-system :asdf)))
(t `(,@(if-let (uiop (uiop-library-pathname))
`(,(make-library-system "uiop" uiop)))
,(make-library-system "asdf" (asdf-library-pathname))))))
(cond
((system-source-directory :uiop) `(,(find-system :uiop)))
((system-source-directory :asdf) `(,(find-system :asdf)))
(t `(,@(if-let (uiop (uiop-library-pathname))
`(,(make-library-system "uiop" uiop)))
,(make-library-system "asdf" (asdf-library-pathname))))))
,@deps)))))
(defmethod perform ((o link-op) (c system))
......@@ -540,18 +540,3 @@ itself.")) ;; operation on a system and its dependencies
"BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~
To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~
Please report to ASDF-DEVEL if this works for you.")))
;;; Backward compatibility with pre-3.1.2 names
;; (defclass fasl-op (selfward-operation)
;; ((selfward-operation :initform 'compile-bundle-op :allocation :class)))
;; (defclass load-fasl-op (selfward-operation)
;; ((selfward-operation :initform 'load-bundle-op :allocation :class)))
;; (defclass binary-op (selfward-operation)
;; ((selfward-operation :initform 'deliver-asd-op :allocation :class)))
;; (defclass monolithic-fasl-op (selfward-operation)
;; ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class)))
;; (defclass monolithic-load-fasl-op (selfward-operation)
;; ((selfward-operation :initform 'monolithic-load-bundle-op :allocation :class)))
;; (defclass monolithic-binary-op (selfward-operation)
;; ((selfward-operation :initform 'monolithic-deliver-asd-op :allocation :class)))
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*-
;;; This is ASDF 3.1.5: Another System Definition Facility.
;;; This is ASDF 3.1.5.5: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
;;; -*- Lisp -*-
(DBG "Test ld-flags in make-image. Should load from ecl-make-image/")
#+ecl
(progn
(chdir #P"ecl-make-image/")
(load "readme.lisp"))
(in-package #:cl-user)
(ffi::clines "extern const char *hello_string;")
(ffi::def-foreign-var ("hello_string" +hello-string+) (* :char) nil)
(print (ffi:convert-from-foreign-string +hello-string+))
const char *hello_string = "Hello world!";
(defsystem #:hellow
:serial t
:components ((:file "hello")))
;;;
;;; DESCRIPTION:
;;;
;;; This file uses a "Hellow world!" string which is in an another C
;;; file called hello_aux.c. Both hello.lisp and hello_aux.c are
;;; compiled and linked into either
;;;
;;; 1) a FASL file (see build_fasl.lisp)
;;; 2) a shared library (see build_dll.lisp)
;;; 3) or a standalone executable file. (build_exe.lisp)
;;;
;;; USE:
;;;
;;; Launch a copy of ECL and load this file in it
;;;
;;; (load "readme.lisp")
;;;
(require 'asdf)
(format t "
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; BUILDING hello_aux.o FILE
;;;
")
;;;
;;; * We compile hello.lisp and hello_aux.c separately.
;;;
;; (compile-file "hello.lisp" :system-p t)
(c::compiler-cc "hello_aux.c" (compile-file-pathname "hello_aux.c" :type :object))
(format t "
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; BUILDING A STANDALONE EXECUTABLE
;;;
")
;;
;; * Combine files in a standalone executable. We reuse the files
;; from the previous example
;;
(defconstant +standalone-exe+ (compile-file-pathname "hellow" :type :program))
(push (make-pathname :name nil :type nil :version nil
:defaults *load-truename*)
asdf:*central-registry*)
(asdf:make-build :hellow
:type :program
:move-here "./"
:prologue-code "printf(\"Good morning sunshine!\");"
:epilogue-code '(progn
(format t "~%Good bye sunshine.~%")
(ext:quit 0))
:ld-flags
(list (namestring (compile-file-pathname "hello_aux.c" :type :object))))
;; This doesnt seem to work
;; (asdf:operate 'asdf:program-op :hellow
;; :ld-flags
;; (list (namestring (compile-file-pathname "hello_aux.c" :type :object))))
;;
;; * Test the program
;;
(format t "
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; TESTING A STANDALONE EXECUTABLE
;;;
")
(uiop:run-program (format nil "./~A" +standalone-exe+) :output *standard-output*)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; CLEAN UP
;;;
;; (delete-file (compile-file-pathname "hello.lisp" :type :object))
(delete-file (compile-file-pathname "hello_aux.c" :type :object))
(delete-file +standalone-exe+)
;;;; a.lisp
(defpackage :sample
(:use #:cl)
(:export #:loaded))
(in-package :sample)
(defparameter loaded t)
;;;; foo.asd
(asdf:defsystem #:sample-system
:serial t
:components ((:file "a")))
;;; -*- Lisp -*-
(unless (or #+(or (and clisp os-unix) clozure cmu
(and ecl (not ecl-bytecmp) (not os-macosx)) lispworks mkcl sbcl scl) t)
(DBG "Creating executables is not supported on your CL implementation")
(leave-test "Skipping test" 0))
(DBG "build sample-system. Should load from sample-system/")
(setf *central-registry* (list (subpathname *test-directory* "sample-system/")))
(make-build 'sample-system
:type :program :monolithic t
#+ecl :epilogue-code #+ecl '(println "blue sky"))
......@@ -7,8 +7,6 @@
(assert (find-system :hello-world-example))
(trace run-program #+(and sbcl os-windows) sb-ext:run-program)
;; Try to load lisp-invocation from xcvb
(initialize-source-registry
`(:source-registry
......
;; -*- Lisp -*-
(declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0)))
#+(and clisp os-windows)
(ext:without-package-lock ()
(trace uiop:run-program uiop/run-program::%run-program uiop/run-program::%system
ext:shell ext:run-shell-command ext:run-program))
#+(and sbcl os-windows) (trace sb-ext:run-program)
;; On Windows, normalize away CRLF into jut the unixy LF.
(defun dewindowize (x)
(block ()
......@@ -93,9 +86,6 @@
(with-output-to-string (*standard-output*)
(run-program "echo ok" :output t :error-output :output)))))
;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess)
;;#+lispworks (trace system:run-shell-command system:pid-exit-status)
#|
Testing run-program
|#
......
......@@ -672,8 +672,7 @@ it will filter them appropriately."
(unless (use-ecl-byte-compiler-p)
(or object-file
#+ecl(compile-file-pathname output-file :type :object)
#+clasp (compile-file-pathname output-file :output-type :object)
)))
#+clasp (compile-file-pathname output-file :output-type :object))))
#+mkcl
(object-file
(or object-file
......
......@@ -426,10 +426,10 @@ It returns a process-info plist with possible keys:
;; NB: these implementations have unix vs windows set at compile-time.
(declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists))
(assert (not (and wait (member :stream (list input output error-output)))))
#-(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl)
#-(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
(progn command keys directory
(error "run-program not available"))
#+(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl)
#+(or allegro clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl)
(let* ((%command (%normalize-command command))
(%input (%normalize-io-specifier input :input))
(%output (%normalize-io-specifier output :output))
......@@ -585,7 +585,7 @@ It returns a process-info plist with possible keys:
#+allegro (sys:reap-os-subprocess :pid process :wait t)
#+clozure (nth-value 1 (ccl:external-process-status process))
#+(or cmu scl) (ext:process-exit-code process)
#+(or clasp ecl) (nth-value 1 (ext:external-process-status process))
#+(or clasp ecl) (nth-value 1 (ext:external-process-wait process))
#+lispworks
(if-let ((stream (or (getf process-info :input-stream)
(getf process-info :output-stream)
......@@ -909,8 +909,11 @@ or an indication of failure via the EXIT-CODE of the process"
(setf force-shell t)))
(flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive))))
(apply (if (or force-shell
#+(or clasp clisp ecl) (or (not ignore-error-status) t)
#+(or clasp clisp) (or (not ignore-error-status) t)
#+clisp (member error-output '(:interactive :output))
;; old versions of ecl <= 15.3.7 don't support non-trivial :error
#+ecl (and (nth-value 1 (ignore-errors (slot-value (ext:make-external-process) 'ext::error-stream)))
(not (member error-output '(:interactive :output nil))))
#+(and lispworks os-unix) (%interactivep input output error-output)
#+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t)
'%use-system '%use-run-program)
......@@ -921,4 +924,4 @@ or an indication of failure via the EXIT-CODE of the process"
:if-output-exists if-output-exists
:if-error-output-exists if-error-output-exists
:element-type element-type :external-format external-format
keys))))
keys))))
......@@ -576,15 +576,17 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e
(check-type direction (member :output :io))
(assert (or want-stream-p want-pathname-p))
(loop
:with prefix = (native-namestring
(ensure-absolute-pathname
(or prefix "tmp")
(or (ensure-pathname directory :namestring :native :ensure-directory t)
#'temporary-directory)))
:with results = ()
:with prefix-pn = (ensure-absolute-pathname
(or prefix "tmp")
(or (ensure-pathname directory :namestring :native :ensure-directory t)
#'temporary-directory))
:with prefix-nns = (native-namestring prefix-pn)
:with results = (progn (ensure-directories-exist prefix-pn)
())
:for counter :from (random (expt 36 #-gcl 8 #+gcl 5))
:for pathname = (parse-native-namestring
(format nil "~A~36R~@[~A~]~@[.~A~]" prefix counter suffix type))
(format nil "~A~36R~@[~A~]~@[.~A~]"
prefix-nns counter suffix (unless (eq type :unspecific) type)))
:for okp = nil :do
;; TODO: on Unix, do something about umask
;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL
......@@ -593,6 +595,7 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e
;; Can we at least design some hook?
(unwind-protect
(progn
(ensure-directories-exist pathname)
(with-open-file (stream pathname
:direction direction
:element-type element-type
......@@ -672,8 +675,13 @@ Further KEYS can be passed to MAKE-PATHNAME."
:defaults pathname keys))
(defun tmpize-pathname (x)
"Return a new pathname modified from X by adding a trivial deterministic suffix"
(add-pathname-suffix x "-TMP"))
"Return a new pathname modified from X by adding a trivial random suffix.
A new empty file with said temporary pathname is created, to ensure there is no
clash with any concurrent process attempting the same thing."
(let* ((px (ensure-pathname x))
(prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp"))
(directory (translate-logical-pathname (pathname-directory-pathname px))))
(get-temporary-file :directory directory :prefix prefix :type (pathname-type px))))
(defun call-with-staging-pathname (pathname fun)
"Calls FUN with a staging pathname, and atomically
......@@ -691,4 +699,3 @@ For the latter case, we ought pick a random suffix and atomically open it."
(defmacro with-staging-pathname ((pathname-var &optional (pathname-value pathname-var)) &body body)
"Trivial syntax wrapper for CALL-WITH-STAGING-PATHNAME"
`(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body))))
......@@ -67,7 +67,7 @@ previously-loaded version of ASDF."
;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "3.1.5")
(asdf-version "3.1.5.5")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment