From eed95a70abfdd4fb5d784572027585e96fb3d520 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Sat, 18 Mar 2017 20:16:50 -0400
Subject: [PATCH] Reproduce staging failure from cl-protobufs-tests

Add test case in test-defsystem-depends-on-phase-overlap.script for a failure
observed when running (test-system "cl-protobufs"):
the action (test-op "cl-protobufs") depends on (load-op "cl-protobufs"),
which gets staged at level 0; it then depends on (test-op "cl-protobufs-tests")
which defsystem-depends-on (load-op "cl-protobufs"), but it has already been
staged, so traverse-action fails to re-stage it at higher priority for level 1,
and fails to perform it before we're back to defsystem "cl-protobufs-tests".
---
 test/defsystem-depends-on/defsystem-dependency.asd   |  3 ++-
 test/defsystem-depends-on/defsystem-dependency.lisp  |  2 ++
 .../defsystem-depends-on/intermediate-dependency.asd |  2 +-
 test/defsystem-depends-on/test-system.asd            |  4 ++++
 test/defsystem-depends-on/test-system.lisp           |  7 +++++++
 test/test-defsystem-depends-on-phase-overlap.script  | 12 ++++++++++--
 6 files changed, 26 insertions(+), 4 deletions(-)
 create mode 100644 test/defsystem-depends-on/test-system.asd
 create mode 100644 test/defsystem-depends-on/test-system.lisp

diff --git a/test/defsystem-depends-on/defsystem-dependency.asd b/test/defsystem-depends-on/defsystem-dependency.asd
index 3f7f139c0..e6059ad0e 100644
--- a/test/defsystem-depends-on/defsystem-dependency.asd
+++ b/test/defsystem-depends-on/defsystem-dependency.asd
@@ -1,3 +1,4 @@
 (defsystem "defsystem-dependency"
   :depends-on ("overlapping-dependency")
-  :components ((:file "defsystem-dependency")))
+  :components ((:file "defsystem-dependency"))
+  :in-order-to ((test-op (test-op "test-system"))))
diff --git a/test/defsystem-depends-on/defsystem-dependency.lisp b/test/defsystem-depends-on/defsystem-dependency.lisp
index c391ea446..0442efc70 100644
--- a/test/defsystem-depends-on/defsystem-dependency.lisp
+++ b/test/defsystem-depends-on/defsystem-dependency.lisp
@@ -1,3 +1,5 @@
 (in-package :asdf-test)
 (defvar *dd* 0)
 (incf *dd*)
+(format t "Loaded defsystem-dependency.lisp ~d time~(~:*~p~)~%" *dd*)
+(setf (find-class 'asdf::my-cl-source-file) (find-class 'cl-source-file))
diff --git a/test/defsystem-depends-on/intermediate-dependency.asd b/test/defsystem-depends-on/intermediate-dependency.asd
index caf4ef95c..dbb020e45 100644
--- a/test/defsystem-depends-on/intermediate-dependency.asd
+++ b/test/defsystem-depends-on/intermediate-dependency.asd
@@ -1,3 +1,3 @@
 (defsystem "intermediate-dependency"
   :defsystem-depends-on ("defsystem-dependency")
-  :components ((:file "intermediate-dependency")))
+  :components ((:my-cl-source-file "intermediate-dependency")))
diff --git a/test/defsystem-depends-on/test-system.asd b/test/defsystem-depends-on/test-system.asd
new file mode 100644
index 000000000..9d3b24b5c
--- /dev/null
+++ b/test/defsystem-depends-on/test-system.asd
@@ -0,0 +1,4 @@
+(defsystem "test-system"
+  :defsystem-depends-on ("defsystem-dependency")
+  :components ((:my-cl-source-file "test-system"))
+  :perform (test-op (o c) (symbol-call :asdf-test :run-test)))
diff --git a/test/defsystem-depends-on/test-system.lisp b/test/defsystem-depends-on/test-system.lisp
new file mode 100644
index 000000000..814acde71
--- /dev/null
+++ b/test/defsystem-depends-on/test-system.lisp
@@ -0,0 +1,7 @@
+(in-package :asdf-test)
+
+(setf *dd* 10)
+
+(defun run-test ()
+  (format t "Running tests...")
+  t)
diff --git a/test/test-defsystem-depends-on-phase-overlap.script b/test/test-defsystem-depends-on-phase-overlap.script
index f4147b477..d1322402b 100644
--- a/test/test-defsystem-depends-on-phase-overlap.script
+++ b/test/test-defsystem-depends-on-phase-overlap.script
@@ -1,7 +1,5 @@
 ;;-*- Lisp -*-
 
-;; TODO: make it files, so that DEFINE-OP can propagate and cause reloading.
-
 (in-package :asdf-test)
 
 (setf *central-registry* (list (subpathname *test-directory* "defsystem-depends-on/")))
@@ -45,3 +43,13 @@
 (with-asdf-session (:override t)
   (load-system "main-system" :force '("overlapping-dependency")))
 (assert-equal (list *od* *dd* *id* *ms*) '(1 1 1 1))
+
+(DBG "actions marked as needed at one level should still be planned if needed at a higher level")
+(reset-vars)
+(setf (find-class 'asdf::my-cl-source-file) nil)
+(asdf::clear-registered-systems)
+(assert-equal *dd* 0)
+(with-asdf-session (:override t)
+  (test-system "defsystem-dependency"))
+(assert-equal *dd* 10)
+
-- 
GitLab