diff options
-rw-r--r-- | src/property/disk.lisp | 12 |
1 files changed, 4 insertions, 8 deletions
diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 42819f9..7a9654a 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -804,14 +804,10 @@ filesystems will be incrementally updated when other properties change." if (and physical-disk-p (not found) (slot-boundp volume 'volume-contents)) do (setq found t) - and collect - (let ((new (make-instance - 'raw-disk-image - :image-file image-pathname - :volume-contents (volume-contents volume)))) - (when (slot-boundp volume 'volume-size) - (setf (volume-size new) (volume-size volume))) - new) + and collect (let ((copy (copy-volume-and-contents volume))) + (change-class copy 'raw-disk-image) + (setf (image-file copy) image-pathname) + copy) else unless physical-disk-p collect volume finally |