From d51e3da4e408b17398f8219d490ec8c10812dfcf Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 9 May 2011 22:12:27 +0000 Subject: [PATCH] 1.0.48.4: source locations for init files Refactor PROCESS-INIT-FILE to share code with LOAD-AS-SOURCE. Also add in contrib/sb-introspect/load-test.lisp which was left out from the last commit. --- NEWS | 6 ++-- contrib/sb-introspect/load-test.lisp | 14 ++++++++ package-data-list.lisp-expr | 1 + src/code/target-load.lisp | 64 ++++++++++++++++------------------ src/code/toplevel.lisp | 37 +++++++------------- tests/init.test.sh | 6 ++++ version.lisp-expr | 2 +- 7 files changed, 68 insertions(+), 62 deletions(-) create mode 100644 contrib/sb-introspect/load-test.lisp diff --git a/NEWS b/NEWS index 15c4775..132c6e7 100644 --- a/NEWS +++ b/NEWS @@ -1,9 +1,7 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- changes relative to sbcl-1.0.48: - * enhancement: functions from files loaded as source now have source - locations. - * enhancement: functions from compile-time-too evaluation now have source - locations. + * enhancement: source locations are now available for files loaded as source, + compile-time-too evaluation, and initialization files. * enhancement: WITH-COMPILATION-UNIT :SOURCE-NAMESTRING allows providing virtual source-file information, eg. overriding input-file of COMPILE-FILE when a temporary file is used for compilation. diff --git a/contrib/sb-introspect/load-test.lisp b/contrib/sb-introspect/load-test.lisp new file mode 100644 index 0000000..3fc51f9 --- /dev/null +++ b/contrib/sb-introspect/load-test.lisp @@ -0,0 +1,14 @@ +;;; +;;; The order of the forms must not change, as the order is checked in +;;; `test-driver.lisp'. Thus do not alter this file unless you edit +;;; test-driver.lisp to match. +;;; + +(declaim (optimize (debug 3))) +(in-package :cl-user) + +(eval-when (:compile-toplevel) + (error "load-test.lisp needs to be loaded as source")) + +(defun loaded-as-source-fun () + t) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 651ba3d..cf4afc2 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1143,6 +1143,7 @@ possibly temporariliy, because it might be used internally." "DEBUG-NAMIFY" "FORCE" "DELAY" "PROMISE-READY-P" "FIND-RESTART-OR-CONTROL-ERROR" + "LOAD-AS-SOURCE" ;; These could be moved back into SB!EXT if someone has ;; compelling reasons, but hopefully we can get by diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp index 6f2912e..48b3fc3 100644 --- a/src/code/target-load.lisp +++ b/src/code/target-load.lisp @@ -28,39 +28,37 @@ ;;;; LOAD-AS-SOURCE ;;; Load a text stream. (Note that load-as-fasl is in another file.) -(defun load-as-source (stream verbose print) +(defun load-as-source (stream &key verbose print (context "loading")) (maybe-announce-load stream verbose) - (macrolet - ((do-sexprs (((sexpr index) stream) &body body) - (aver (symbolp sexpr)) - (with-unique-names (source-info) - (once-only ((stream stream)) - `(if (handler-case (pathname stream) - (error () nil)) - (let* ((,source-info (sb!c::make-file-source-info - (pathname ,stream) - (stream-external-format ,stream))) - (sb!c::*source-info* ,source-info) - (sb!c::*source-paths* (make-hash-table :test 'eq))) - (setf (sb!c::source-info-stream ,source-info) ,stream) - (sb!c::do-forms-from-info ((,sexpr current-index) - ,source-info) - (sb!c::find-source-paths ,sexpr current-index) - (let ((,index current-index)) - ,@body))) - (let ((sb!c::*source-info* nil) - (,index nil)) - (do ((,sexpr (read ,stream nil *eof-object*) - (read ,stream nil *eof-object*))) - ((eq ,sexpr *eof-object*)) - ,@body))))))) - (do-sexprs ((sexpr tlf-index) stream) - (if print - (let ((results (multiple-value-list (eval-tlf sexpr tlf-index)))) - (load-fresh-line) - (format t "~{~S~^, ~}~%" results)) - (eval-tlf sexpr tlf-index))) - t)) + (let* ((pathname (ignore-errors (translate-logical-pathname stream))) + (native (when pathname (native-namestring pathname)))) + (with-simple-restart (abort "Abort ~A file ~S." context native) + (flet ((eval-form (form index) + (with-simple-restart (continue "Ignore error and continue ~A file ~S." + context native) + (loop + (with-simple-restart (retry "Retry EVAL of current toplevel form.") + (if print + (let ((results (multiple-value-list (eval-tlf form index)))) + (load-fresh-line) + (format t "~{~S~^, ~}~%" results)) + (eval-tlf form index))) + (return))))) + (if pathname + (let* ((info (sb!c::make-file-source-info + pathname (stream-external-format stream))) + (sb!c::*source-info* info) + (sb!c::*source-paths* (make-hash-table :test 'eq))) + (setf (sb!c::source-info-stream info) stream) + (sb!c::do-forms-from-info ((form current-index) info) + (sb!c::find-source-paths form current-index) + (eval-form form current-index))) + (let ((sb!c::*source-info* nil)) + (do ((form (read stream nil *eof-object*) + (read stream nil *eof-object*))) + ((eq form *eof-object*)) + (eval-form form nil))))))) + t) ;;;; LOAD itself @@ -119,7 +117,7 @@ (return-from load (if faslp (load-as-fasl stream verbose print) - (load-as-source stream verbose print)))))) + (load-as-source stream :verbose verbose :print print)))))) ;; Case 1: stream. (when (streamp pathspec) (return-from load (load-stream pathspec (fasl-header-p pathspec)))) diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index f519002..7c84ba6 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -245,30 +245,19 @@ any non-negative real number." (values "sysinit" *sysinit-pathname-function*)) (:user (values "userinit" *userinit-pathname-function*))) - (flet ((process-stream (stream pathname) - (with-simple-restart (abort "Skip rest of ~A file ~S." - context (native-namestring pathname)) - (loop - (with-simple-restart - (continue "Ignore error and continue processing ~A file ~S." - context (native-namestring pathname)) - (let ((form (read stream nil stream))) - (if (eq stream form) - (return-from process-init-file nil) - (eval form)))))))) - (if specified-pathname - (with-open-file (stream (parse-native-namestring specified-pathname) - :if-does-not-exist nil) - (if stream - (process-stream stream (pathname stream)) - (cerror "Ignore missing init file" - "The specified ~A file ~A was not found." - context specified-pathname))) - (let ((default (funcall default-function))) - (when default - (with-open-file (stream (pathname default) :if-does-not-exist nil) - (when stream - (process-stream stream (pathname stream)))))))))) + (if specified-pathname + (with-open-file (stream (parse-native-namestring specified-pathname) + :if-does-not-exist nil) + (if stream + (load-as-source stream :context context) + (cerror "Ignore missing init file" + "The specified ~A file ~A was not found." + context specified-pathname))) + (let ((default (funcall default-function))) + (when default + (with-open-file (stream (pathname default) :if-does-not-exist nil) + (when stream + (load-as-source stream :context context)))))))) (defun process-eval/load-options (options) (/show0 "handling --eval and --load options") diff --git a/tests/init.test.sh b/tests/init.test.sh index fed1fb8..642d5ca 100644 --- a/tests/init.test.sh +++ b/tests/init.test.sh @@ -20,6 +20,7 @@ use_test_subdirectory tmpcore="init-test.core" run_sbcl <