Commit a77754c8 authored by Marius Gerbershagen's avatar Marius Gerbershagen
Browse files

objects: make-load-form: add tests for correct ordering of load time forms

parent bee13cc5
......@@ -35,6 +35,7 @@
(load "make-instance.lsp")
(load "make-instances-obsolete.lsp")
(load "make-load-form.lsp")
(load "make-load-form-order.lsp")
(load "make-load-form-saving-slots.lsp")
(load "with-accessors.lsp")
(load "with-slots.lsp")
......
;-*- Mode: Lisp -*-
;;;; Author: Marius Gerbershagen
;;;; Created: Sat Dec 19 12:27:21 2020
;;;; Contains: Tests which check that the compiler and loader correctly order load time forms
;;; Ordering constraints
;;;
;;; CLHS make-load-form:
;;;
;;; > Each initialization form is evaluated as soon as possible after
;;; its associated creation form, as determined by data flow. If the
;;; initialization form for an object does not reference any other
;;; objects not referenced earlier in the file and processed by the
;;; file compiler using make-load-form, the initialization form is
;;; evaluated immediately after the creation form.
;;;
;;; > If a creation or initialization form F does contain references
;;; to such objects, the creation forms for those other objects are
;;; evaluated before F, and the initialization forms for those other
;;; objects are also evaluated before F whenever they do not depend
;;; on the object created or initialized by F.
;;; Note:
;;;
;;; Many implementations do not strictly follow the spec in this
;;; regard, in particular for the ordering of initialization forms.
;;; This is usually not a big problem, because load time forms which
;;; need a proper implementation of the spec in order to correctly
;;; reconstruct objects (for example due to initialization forms that
;;; access slots of previously created load time forms) are uncommon
;;; in practice.
(in-package :cl-test)
(defclass load-form-test-object ()
((name :initarg :name :reader load-form-test-name)
(make-dependency1 :initarg :make-dependency1 :accessor load-form-test-make-dependency1 :initform nil)
(make-dependency2 :initarg :make-dependency2 :accessor load-form-test-make-dependency2 :initform nil)
(init-dependency1 :initarg :init-dependency1 :accessor load-form-test-init-dependency1 :initform nil)
(init-dependency2 :initarg :init-dependency2 :accessor load-form-test-init-dependency2 :initform nil)))
(defvar *load-form-test-order* nil)
(defmethod make-load-form ((x load-form-test-object) &optional environment)
(declare (ignore environment))
(values
`(progn
(push :creating *load-form-test-order*)
(push ',(load-form-test-name x) *load-form-test-order*)
(make-instance ',(class-of x) :name ',(load-form-test-name x)
:make-dependency1 ',(slot-value x 'make-dependency1)
:make-dependency2 ',(slot-value x 'make-dependency2)))
`(progn
(push :initializing *load-form-test-order*)
(push ',(load-form-test-name x) *load-form-test-order*)
(setf (load-form-test-init-dependency1 ',x) ',(slot-value x 'init-dependency1))
(setf (load-form-test-init-dependency2 ',x) ',(slot-value x 'init-dependency2)))))
(defmethod print-object ((obj load-form-test-object) stream)
(write (load-form-test-name obj) :stream stream))
(defun write-text-compile-and-load (text)
(let ((file "make-load-form-test.lsp"))
(with-open-file (s file :direction :output :if-exists :supersede
:if-does-not-exist :create)
(write-string "(in-package #:cl-test)" s)
(write-string text s))
(let ((compiled-file (compile-file file :verbose nil :print nil)))
(if compiled-file
(load compiled-file)
(error "Compilation failed")))))
(defmacro def-load-form-test (name text checks expected-ordering)
`(deftest ,name
(progn (setf *load-form-test-order* nil)
(write-text-compile-and-load ,text)
(let ((results (list ,@checks
(reverse *load-form-test-order*))))
(mapcar #'makunbound '(*a* *b* *c* *aa* *bb* *cc*))
(values-list results)))
,@(loop repeat (length checks) collect t)
,expected-ordering))
;;; no dependencies: load time forms are evaluated in the same order
;;; as the definition of the literal objects
(def-load-form-test make-load-form.order.1
"(defparameter *a* #.(make-instance 'load-form-test-object :name 'a))"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil))
(:creating a :initializing a))
(def-load-form-test make-load-form.order.2
"(defparameter *a* #.(make-instance 'load-form-test-object :name 'a))
(defparameter *b* #.(make-instance 'load-form-test-object :name 'b))"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) nil)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating a :initializing a :creating b :initializing b))
;;; dependencies only in init form
(def-load-form-test make-load-form.order.3
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(setf (load-form-test-init-dependency1 *bb*) *aa*))
(defparameter *a* #.*aa*)
(defparameter *b* #.*bb*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) nil)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) *a*)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating a :initializing a ; no dependencies for a
:creating b :initializing b))
;; make-load-form.order.3 in reverse order, (defparameter *b* #.*bb*) before (defparameter *a* #.*aa*)
(def-load-form-test make-load-form.order.4
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(setf (load-form-test-init-dependency1 *bb*) *aa*))
(defparameter *b* #.*bb*)
(defparameter *a* #.*aa*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) nil)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) *a*)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating b ; no dependency for creation form of b
:creating a ; *a* must be created before *b* is initialized
:initializing a ; no dependency for init form of a, evaluate immediately after creating a
:initializing b))
;;; dependencies only in make form
(def-load-form-test make-load-form.order.5
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(setf (load-form-test-make-dependency1 *bb*) *aa*))
(defparameter *a* #.*aa*)
(defparameter *b* #.*bb*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating a :initializing a :creating b :initializing b))
;; make-load-form.order.5 in reverse order
(def-load-form-test make-load-form.order.6
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(setf (load-form-test-make-dependency1 *bb*) *aa*))
(defparameter *b* #.*bb*)
(defparameter *a* #.*aa*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating a ; *a* must be created before *b* is created
:initializing a ; no dependency for init form of a, evaluate immediately after creating a
:creating b :initializing b))
;;; circular dependency
(def-load-form-test make-load-form.order.7
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(setf (load-form-test-make-dependency1 *bb*) *aa*)
(setf (load-form-test-init-dependency1 *aa*) *bb*))
(defparameter *a* #.*aa*)
(defparameter *b* #.*bb*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) *b*)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating a ; no dependencies for creation form of a
:creating b ; *b* must be created *b* before *a* is initialized
:initializing b ; no dependencies for init form of b, evaluate immediately after creating a
:initializing a))
;; make-load-form.order.7 in reverse order
(def-load-form-test make-load-form.order.8
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(setf (load-form-test-make-dependency1 *bb*) *aa*)
(setf (load-form-test-init-dependency1 *aa*) *bb*))
(defparameter *b* #.*bb*)
(defparameter *a* #.*aa*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) *b*)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil))
(:creating a :creating b :initializing b :initializing a))
;;; 3 load forms, transitive make dependencies
(def-load-form-test make-load-form.order.9
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(defparameter *cc* (make-instance 'load-form-test-object :name 'c))
(setf (load-form-test-make-dependency1 *bb*) *aa*)
(setf (load-form-test-make-dependency1 *cc*) *bb*)
(setf (load-form-test-make-dependency2 *cc*) *aa*))
(defparameter *a* #.*aa*)
(defparameter *b* #.*bb*)
(defparameter *c* #.*cc*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil)
(eql (load-form-test-name *c*) 'c)
(eql (load-form-test-make-dependency1 *c*) *b*)
(eql (load-form-test-make-dependency2 *c*) *a*)
(eql (load-form-test-init-dependency1 *c*) nil)
(eql (load-form-test-init-dependency2 *c*) nil))
(:creating a :initializing a :creating b :initializing b :creating c :initializing c))
;; make-load-form.order.9 in reverse order
(def-load-form-test make-load-form.order.10
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(defparameter *cc* (make-instance 'load-form-test-object :name 'c))
(setf (load-form-test-make-dependency1 *bb*) *aa*)
(setf (load-form-test-make-dependency1 *cc*) *bb*)
(setf (load-form-test-make-dependency2 *cc*) *aa*))
(defparameter *c* #.*cc*)
(defparameter *b* #.*bb*)
(defparameter *a* #.*aa*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) nil)
(eql (load-form-test-init-dependency2 *b*) nil)
(eql (load-form-test-name *c*) 'c)
(eql (load-form-test-make-dependency1 *c*) *b*)
(eql (load-form-test-make-dependency2 *c*) *a*)
(eql (load-form-test-init-dependency1 *c*) nil)
(eql (load-form-test-init-dependency2 *c*) nil))
(:creating a :initializing a :creating b :initializing b :creating c :initializing c))
;;; 3 load forms, transitive init dependencies
(def-load-form-test make-load-form.order.11
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(defparameter *cc* (make-instance 'load-form-test-object :name 'c))
(setf (load-form-test-init-dependency1 *bb*) *aa*)
(setf (load-form-test-init-dependency1 *cc*) *bb*)
(setf (load-form-test-init-dependency2 *cc*) *aa*))
(defparameter *a* #.*aa*)
(defparameter *b* #.*bb*)
(defparameter *c* #.*cc*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) nil)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) *a*)
(eql (load-form-test-init-dependency2 *b*) nil)
(eql (load-form-test-name *c*) 'c)
(eql (load-form-test-make-dependency1 *c*) nil)
(eql (load-form-test-make-dependency2 *c*) nil)
(eql (load-form-test-init-dependency1 *c*) *b*)
(eql (load-form-test-init-dependency2 *c*) *a*))
(:creating a :initializing a :creating b :initializing b :creating c :initializing c))
;; make-load-form.order.11 in reverse order
(def-load-form-test make-load-form.order.12
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(defparameter *cc* (make-instance 'load-form-test-object :name 'c))
(setf (load-form-test-init-dependency1 *bb*) *aa*)
(setf (load-form-test-init-dependency1 *cc*) *bb*)
(setf (load-form-test-init-dependency2 *cc*) *aa*))
(defparameter *c* #.*cc*)
(defparameter *b* #.*bb*)
(defparameter *a* #.*aa*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) nil)
(eql (load-form-test-init-dependency2 *a*) nil)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) nil)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) *a*)
(eql (load-form-test-init-dependency2 *b*) nil)
(eql (load-form-test-name *c*) 'c)
(eql (load-form-test-make-dependency1 *c*) nil)
(eql (load-form-test-make-dependency2 *c*) nil)
(eql (load-form-test-init-dependency1 *c*) *b*)
(eql (load-form-test-init-dependency2 *c*) *a*))
(:creating c :creating b :creating a :initializing a :initializing b :initializing c))
;;; 3 load forms, circular dependencies
(def-load-form-test make-load-form.order.13
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(defparameter *cc* (make-instance 'load-form-test-object :name 'c))
(setf (load-form-test-make-dependency1 *bb*) *aa*)
(setf (load-form-test-make-dependency1 *cc*) *bb*)
(setf (load-form-test-make-dependency2 *cc*) *aa*)
(setf (load-form-test-init-dependency1 *bb*) *cc*)
(setf (load-form-test-init-dependency1 *aa*) *cc*)
(setf (load-form-test-init-dependency2 *aa*) *bb*))
(defparameter *a* #.*aa*)
(defparameter *b* #.*bb*)
(defparameter *c* #.*cc*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) *c*)
(eql (load-form-test-init-dependency2 *a*) *b*)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) *c*)
(eql (load-form-test-init-dependency2 *b*) nil)
(eql (load-form-test-name *c*) 'c)
(eql (load-form-test-make-dependency1 *c*) *b*)
(eql (load-form-test-make-dependency2 *c*) *a*)
(eql (load-form-test-init-dependency1 *c*) nil)
(eql (load-form-test-init-dependency2 *c*) nil))
(:creating a :creating b :creating c :initializing c :initializing b :initializing a))
;; make-load-form.order.13 in reverse order
(def-load-form-test make-load-form.order.14
"(eval-when (:compile-toplevel)
(defparameter *aa* (make-instance 'load-form-test-object :name 'a))
(defparameter *bb* (make-instance 'load-form-test-object :name 'b))
(defparameter *cc* (make-instance 'load-form-test-object :name 'c))
(setf (load-form-test-make-dependency1 *bb*) *aa*)
(setf (load-form-test-make-dependency1 *cc*) *bb*)
(setf (load-form-test-make-dependency2 *cc*) *aa*)
(setf (load-form-test-init-dependency1 *bb*) *cc*)
(setf (load-form-test-init-dependency1 *aa*) *cc*)
(setf (load-form-test-init-dependency2 *aa*) *bb*))
(defparameter *c* #.*cc*)
(defparameter *b* #.*bb*)
(defparameter *a* #.*aa*)"
((eql (load-form-test-name *a*) 'a)
(eql (load-form-test-make-dependency1 *a*) nil)
(eql (load-form-test-make-dependency2 *a*) nil)
(eql (load-form-test-init-dependency1 *a*) *c*)
(eql (load-form-test-init-dependency2 *a*) *b*)
(eql (load-form-test-name *b*) 'b)
(eql (load-form-test-make-dependency1 *b*) *a*)
(eql (load-form-test-make-dependency2 *b*) nil)
(eql (load-form-test-init-dependency1 *b*) *c*)
(eql (load-form-test-init-dependency2 *b*) nil)
(eql (load-form-test-name *c*) 'c)
(eql (load-form-test-make-dependency1 *c*) *b*)
(eql (load-form-test-make-dependency2 *c*) *a*)
(eql (load-form-test-init-dependency1 *c*) nil)
(eql (load-form-test-init-dependency2 *c*) nil))
(:creating a :creating b :creating c :initializing c :initializing b :initializing a))
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