Handle explicit/deleted copy constructor and assignment

src/gen/common/generator/function.lisp

@@ -96,8 +96,8 @@
                                   :location param-location)
                         :name (c-name->lisp param-name :parameter)
                         :value (cond
-                                 ((and (typep adapted 'claw.spec:foreign-reference)
-                                       (claw.spec:foreign-reference-rvalue-p adapted))
+                                 ((and adapted
+                                       (not (claw.spec:foreign-type-copy-constructible-p adapted)))
                                   (format nil "std::move(*~A)" param-name))
                                  (adapted (format nil "*~A" param-name))
                                  (t param-name))

src/gen/iffi/cxx/generator/class.lisp

@@ -42,16 +42,10 @@
 
 (defun adapt-setter (record field)
   (let* ((field-name (claw.spec:foreign-entity-name field))
-         (original-type (claw.spec:foreign-enveloped-entity field))
-         (unaliased (claw.spec:unalias-foreign-entity original-type)))
-    (multiple-value-bind (field-type adapted-p)
-        (adapt-type original-type)
-      (unless (or (typep unaliased 'claw.spec:foreign-array)
-                  (typep (if (or (typep unaliased 'claw.spec:foreign-pointer)
-                                 (typep unaliased 'claw.spec:foreign-reference))
-                             (claw.spec:foreign-enveloped-entity unaliased)
-                             unaliased)
-                         'claw.spec:foreign-const-qualifier))
+         (original-type (claw.spec:foreign-enveloped-entity field)))
+    (when (claw.spec:foreign-type-assignable-p original-type)
+      (multiple-value-bind (field-type adapted-p)
+          (adapt-type original-type)
         (make-instance 'adapted-function
                        :name (format nil "set_~A_~A"
                                      (mangle-entity-name record)

src/resect/resect.lisp

@@ -502,6 +502,16 @@
     (with-slots (deps) this
       (push dependent deps))))
 
+(defmethod foreign-type-assignable-p ((record resect-record))
+  (and (call-next-method)
+       ;; For templates like `std::optional', `std::vector', etc., we don't see the class
+       ;; declaration, but it's a pretty safe assumption that an instantiation includes at least
+       ;; one field of the argument type.
+       (every (lambda (arg)
+                (or (not (typep (foreign-entity-parameter arg) 'foreign-entity-type-parameter))
+                    (foreign-type-assignable-p (foreign-entity-value arg))))
+              (arguments-of record))))
+
 (defclass resect-struct (resect-record foreign-struct) ())
 
 (defclass resect-union (resect-record foreign-union) ())
@@ -798,6 +808,11 @@
                              :bit-size (%resect:type-size decl-type)
                              :bit-alignment (%resect:type-alignment decl-type)
                              :plain-old-data-type (%resect:type-plain-old-data-p decl-type)
+                             :explicit-copy-constructor (%resect:type-has-copy-constructor-p decl-type)
+                             :deleted-copy-constructor (%resect:type-copy-constructor-deleted-p decl-type)
+                             ;; Move assigment ops don't matter for our purposes.
+                             :explicit-assignment (%resect:type-has-copy-assignment-p decl-type)
+                             :deleted-assignment (%resect:type-copy-assignment-deleted-p decl-type)
                              :abstract (%resect:record-abstract-p decl)
                              :private (or (foreign-entity-private-p owner)
                                           (not (publicp decl))

src/spec/entity.lisp

@@ -26,6 +26,8 @@
            #:foreign-entity-bit-alignment
 
            #:foreign-plain-old-data-type-p
+           #:foreign-type-assignable-p
+           #:foreign-type-copy-constructible-p
 
            #:foreign-entity-location
 
@@ -277,12 +279,22 @@
                           :initform nil
                           :reader foreign-plain-old-data-type-p)))
 
+(defgeneric foreign-type-assignable-p (foreign-type))
+
+(defgeneric foreign-type-copy-constructible-p (foreign-type))
+
 
 ;;;
 ;;; PRIMITIVE
 ;;;
 (defclass foreign-primitive (foreign-type) ())
 
+(defmethod foreign-type-assignable-p ((type foreign-primitive))
+  t)
+
+(defmethod foreign-type-copy-constructible-p ((type foreign-primitive))
+  t)
+
 
 ;;;
 ;;; CONSTANT
@@ -304,6 +316,13 @@
          :initform nil
          :reader foreign-enum-type)))
 
+(defmethod foreign-type-assignable-p ((type foreign-enum))
+  t)
+
+(defmethod foreign-type-copy-constructible-p ((type foreign-enum))
+  t)
+
+
 ;;;
 ;;; TEMPLATABLE
 ;;;
@@ -409,7 +428,54 @@
               :reader foreign-entity-private-p)
    (forward-p :initarg :forward
               :initform nil
-              :reader foreign-entity-forward-p)))
+              :reader foreign-entity-forward-p)
+   (has-explicit-assignment-p :initarg :explicit-assignment
+                              :initform nil
+                              :reader foreign-record-has-explicit-assignment-p)
+   (has-deleted-assignment-p :initarg :deleted-assignment
+                             :initform nil
+                             :reader foreign-record-has-deleted-assignment-p)
+   (has-explicit-copy-constructor-p :initarg :explicit-copy-constructor
+                                    :initform nil
+                                    :reader foreign-record-has-explicit-copy-constructor-p)
+   (has-deleted-copy-constructor-p :initarg :deleted-copy-constructor
+                                   :initform nil
+                                   :reader foreign-record-has-deleted-copy-constructor-p)))
+
+(defmethod foreign-type-assignable-p ((record foreign-record))
+  (and (not (or (foreign-record-has-deleted-assignment-p record)
+                (foreign-type-known-non-copyable-p record)))
+       (or (foreign-record-has-explicit-assignment-p record)
+           (and (every (lambda (field)
+                         (let ((field-type (foreign-enveloped-entity field)))
+                           ;; You can normally assign through a non-const reference, but
+                           ;; C++ won't generate an implicit assignment operator that
+                           ;; assigns to a reference field.
+                           (or (and (foreign-type-assignable-p field-type)
+                                    (not (typep field-type 'foreign-reference)))
+                               ;; Top-level arrays are not assignable, but as fields of records
+                               ;; they become so, if their element type is.
+                               (and (typep field-type 'foreign-array)
+                                    (foreign-type-assignable-p (foreign-enveloped-entity field-type))))))
+                       (foreign-record-fields record))
+                (every #'foreign-type-assignable-p (foreign-record-parents record))))))
+
+(defmethod foreign-type-copy-constructible-p ((record foreign-record))
+  (and (not (or (foreign-record-has-deleted-copy-constructor-p record)
+                (foreign-type-known-non-copyable-p record)))
+       (or (foreign-record-has-explicit-copy-constructor-p record)
+           (and (every (compose #'foreign-type-copy-constructible-p
+                                #'foreign-enveloped-entity)
+                       (foreign-record-fields record))
+                (every #'foreign-type-copy-constructible-p
+                       (foreign-record-parents record))))))
+
+(defun foreign-type-known-non-copyable-p (record)
+  ;; We don't want to force the user to include these in their wrapper, so we special-case them.
+  (and (string= (foreign-entity-namespace record) "std")
+       (let ((name (foreign-entity-name record)))
+         (some (lambda (str) (string= name str :end1 (min (length str) (length name))))
+               '("unique_ptr")))))
 
 
 (defmethod foreign-entity-forward-p (any)
@@ -450,6 +516,13 @@
                :reader foreign-function-variadic-p)))
 
 
+(defmethod foreign-type-assignable-p ((proto foreign-function-prototype))
+  nil)
+
+(defmethod foreign-type-copy-constructible-p ((proto foreign-function-prototype))
+  nil)
+
+
 (defclass foreign-function (declared
                             identified
                             named
@@ -496,6 +569,12 @@
                  :location (foreign-entity-location entity)
                  :enveloped value))
 
+(defmethod foreign-type-assignable-p ((alias foreign-alias))
+  (foreign-type-assignable-p (foreign-enveloped-entity alias)))
+
+(defmethod foreign-type-copy-constructible-p ((alias foreign-alias))
+  (foreign-type-copy-constructible-p (foreign-enveloped-entity alias)))
+
 
 ;;;
 ;;; ARRAY
@@ -516,6 +595,13 @@
                  :dimensions (foreign-array-dimensions entity)
                  :enveloped value))
 
+(defmethod foreign-type-assignable-p ((array foreign-array))
+  ;; Top-level arrays are not assignable, but see the method on `foreign-record'.
+  nil)
+
+(defmethod foreign-type-copy-constructible-p ((array foreign-array))
+  (foreign-type-copy-constructible-p (foreign-enveloped-entity array)))
+
 
 ;;;
 ;;; POINTER
@@ -526,6 +612,13 @@
 (defmethod rewrap-foreign-envelope ((entity foreign-pointer) value)
   (make-instance 'foreign-pointer :enveloped value))
 
+(defmethod foreign-type-assignable-p ((pointer foreign-pointer))
+  t)
+
+(defmethod foreign-type-copy-constructible-p ((pointer foreign-pointer))
+  t)
+
+
 ;;;
 ;;; REFERENCE
 ;;;
@@ -540,6 +633,16 @@
                  :rvalue (foreign-reference-rvalue-p entity)
                  :enveloped value))
 
+(defmethod foreign-type-assignable-p ((reference foreign-reference))
+  (foreign-type-assignable-p (foreign-enveloped-entity reference)))
+
+(defmethod foreign-type-copy-constructible-p ((reference foreign-reference))
+  ;; Technically, lvalue references aren't constructed, but as field types they don't prevent
+  ;; the containing record from being copy-constructible.
+  ;; Rvalue references can't be field types, but they also can't be copied.
+  (not (foreign-reference-rvalue-p reference)))
+
+
 ;;;
 ;;; VARIABLE
 ;;;
@@ -565,6 +668,11 @@
 ;;;
 (defclass foreign-const-qualifier (foreign-qualifier) ())
 
+(defmethod foreign-type-assignable-p ((qual foreign-const-qualifier))
+  nil)
+
+(defmethod foreign-type-copy-constructible-p ((qual foreign-const-qualifier))
+  (foreign-type-copy-constructible-p (foreign-enveloped-entity qual)))
 
 ;;;
 ;;; UNKNOWN