diff --git a/find-component.lisp b/find-component.lisp
index 19360783496a9d7f5cfbf16bd9abba444a32f293..01a68ff6298f9740cb9bfb649cfcc5c0d0a4ba91 100644
--- a/find-component.lisp
+++ b/find-component.lisp
@@ -50,36 +50,41 @@
 ;;;; Finding components
 
 (with-upgradability ()
-  (defgeneric* (find-component) (base path)
+  (defgeneric* (find-component) (base path &key registered)
     (:documentation "Find a component by resolving the PATH starting from BASE parent"))
   (defgeneric resolve-dependency-combination (component combinator arguments))
 
-  (defmethod find-component ((base string) path)
-    (let ((s (find-system base nil)))
-      (and s (find-component s path))))
+  (defmethod find-component ((base string) path &key registered)
+    (if-let ((s (if registered
+                    (registered-system base)
+                    (find-system base nil))))
+      (find-component s path :registered registered)))
 
-  (defmethod find-component ((base symbol) path)
+  (defmethod find-component ((base symbol) path &key registered)
     (cond
-      (base (find-component (coerce-name base) path))
-      (path (find-component path nil))
+      (base (find-component (coerce-name base) path :registered registered))
+      (path (find-component path nil :registered registered))
       (t    nil)))
 
-  (defmethod find-component ((base cons) path)
-    (find-component (car base) (cons (cdr base) path)))
+  (defmethod find-component ((base cons) path &key registered)
+    (find-component (car base) (cons (cdr base) path) :registered registered))
 
-  (defmethod find-component ((parent parent-component) (name string))
-    (compute-children-by-name parent :only-if-needed-p t) ;; SBCL may miss the u-i-f-r-c method!!!
+  (defmethod find-component ((parent parent-component) (name string) &key registered)
+    (declare (ignorable registered))
+    (compute-children-by-name parent :only-if-needed-p t)
     (values (gethash name (component-children-by-name parent))))
 
-  (defmethod find-component (base (name symbol))
+  (defmethod find-component (base (name symbol) &key registered)
     (if name
-        (find-component base (coerce-name name))
+        (find-component base (coerce-name name) :registered registered)
         base))
 
-  (defmethod find-component ((c component) (name cons))
-    (find-component (find-component c (car name)) (cdr name)))
+  (defmethod find-component ((c component) (name cons) &key registered)
+    (find-component (find-component c (car name) :registered registered)
+                    (cdr name) :registered registered))
 
-  (defmethod find-component ((base t) (actual component))
+  (defmethod find-component ((base t) (actual component) &key registered)
+    (declare (ignorable registered))
     actual)
 
   (defun resolve-dependency-name (component name &optional version)
diff --git a/operate.lisp b/operate.lisp
index 68e14c17ae688ced5387489937cb208a1316e761..53c4b68fbc88776d9c99c9722c089658e2472a29 100644
--- a/operate.lisp
+++ b/operate.lisp
@@ -167,7 +167,8 @@ to load it in current image."
   (defun component-loaded-p (component)
     "Has given COMPONENT been successfully loaded in the current image (yet)?
 Note that this returns true even if the component is not up to date."
-    (action-already-done-p nil (make-instance 'load-op) (find-component component ())))
+    (if-let ((component (find-component component () :registered t)))
+      (action-already-done-p nil (make-instance 'load-op) component)))
 
   (defun already-loaded-systems ()
     "return a list of the names of the systems that have been successfully loaded so far"
@@ -176,7 +177,8 @@ Note that this returns true even if the component is not up to date."
   (defun require-system (system &rest keys &key &allow-other-keys)
     "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but skip any update to the
 system or its dependencies if they have already been loaded."
-    (apply 'load-system system :force-not (already-loaded-systems) keys)))
+    (unless (component-loaded-p system)
+      (apply 'load-system system :force-not (already-loaded-systems) keys))))
 
 
 ;;;; Define the class REQUIRE-SYSTEM, to be hooked into CL:REQUIRE when possible,
diff --git a/test/test-force.script b/test/test-force.script
index f760bdeb0dcff611a5e28d46299fee00bc4d6649..a03c4e691a767d7a5882acc314d2abbc29411d03 100644
--- a/test/test-force.script
+++ b/test/test-force.script
@@ -87,19 +87,17 @@
 
 (setf test-package::*file3* :reset)
 
-(DBG "Check that require-system of touched .asd will reload the asdf.")
-(DBG "(That's what it does now, but if it could be fixed that'd be nice.)")
+(DBG "Check that require-system called with touched .asd won't reload the asdf.")
 (unset-asdf-cache-entry '(find-system "test-asdf"))
 (unset-asdf-cache-entry '(find-system "test-asdf/force"))
 (touch-file "test-asdf.asd" :timestamp (+ 10000 (get-file-stamp file1)))
 (require-system 'test-asdf/force)
-(assert-equal (asymval :*times-loaded* :test-asdf-system) 2)
+(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
 (assert-equal test-package::*file3* :reset)
 
-(DBG "Check that require-system of untouched .asd won't reload the asdf.")
+(DBG "Check that require-system called with untouched .asd won't reload the asdf.")
 (require-system 'test-asdf/force)
 
 ;;; Somehow, it loads the system...
-(with-expected-failure (t)
-  (assert-equal (asymval :*times-loaded* :test-asdf-system) 2)
-  (assert-equal test-package::*file3* :reset))
+(assert-equal (asymval :*times-loaded* :test-asdf-system) 1)
+(assert-equal test-package::*file3* :reset)