[flang] Check for non-interoperable intrinsic types in BIND(C) derived types

[klausler]

Summary

Every component of a BIND(C) interoperable derived type must have an
interoperable type. Semantics was checking components with derived types,
but not components with intrinsic types.

flang/include/flang/Evaluate/type.h

 std::optional<DynamicType> ComparisonType(
     const DynamicType &, const DynamicType &);
 
+bool IsInteroperableIntrinsicType(const DynamicType &);
+
 // For generating "[extern] template class", &c. boilerplate
 #define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \
   M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16)

flang/include/flang/Semantics/type.h

   return const_cast<DeclTypeSpec *>(this)->AsDerived();
 }
 
+bool IsInteroperableIntrinsicType(const DeclTypeSpec &);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TYPE_H_

flang/lib/Evaluate/type.cpp

   }
 }
 
+bool IsInteroperableIntrinsicType(const DynamicType &type) {
+  switch (type.category()) {
+  case TypeCategory::Integer:
+    return true;
+  case TypeCategory::Real:
+  case TypeCategory::Complex:
+    return type.kind() >= 4; // no short or half floats
+  case TypeCategory::Logical:
+    return type.kind() == 1; // C_BOOL
+  case TypeCategory::Character:
+    return type.kind() == 1 /* C_CHAR */ && type.knownLength().value_or(0) == 1;
+  default:
+    // Derived types are tested in Semantics/check-declarations.cpp
+    return false;
+  }
+}
+
 } // namespace Fortran::evaluate

flang/lib/Semantics/check-declarations.cpp

               "A derived type with the BIND attribute cannot have a pointer or allocatable component"_err_en_US);
           context_.SetError(symbol);
           break;
-        } else if (component->GetType() && component->GetType()->AsDerived() &&
-            !component->GetType()->AsDerived()->typeSymbol().attrs().test(
-                Attr::BIND_C)) {
-          messages_.Say(component->GetType()->AsDerived()->typeSymbol().name(),
-              "The component of the interoperable derived type must have the BIND attribute"_err_en_US);
-          context_.SetError(symbol);
-          break;
+        } else if (const auto *type{component->GetType()}) {
+          if (const auto *derived{type->AsDerived()}) {
+            if (!derived->typeSymbol().attrs().test(Attr::BIND_C)) {
+              messages_.Say(
+                  component->GetType()->AsDerived()->typeSymbol().name(),
+                  "The component of the interoperable derived type must have the BIND attribute"_err_en_US);
+              context_.SetError(symbol);
+              break;
+            }
+          } else if (!IsInteroperableIntrinsicType(*type)) {
+            messages_.Say(component->name(),
+                "Each component of an interoperable derived type must have an interoperable type"_err_en_US);
+            context_.SetError(symbol);
+            break;
+          }
         }
       }
     }

flang/lib/Semantics/type.cpp

 #include "compute-offsets.h"
 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/type.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/parse-tree-visitor.h"
 #include "flang/Semantics/scope.h"

   return o << x.AsFortran();
 }
 
+bool IsInteroperableIntrinsicType(const DeclTypeSpec &type) {
+  auto dyType{evaluate::DynamicType::From(type)};
+  return dyType && IsInteroperableIntrinsicType(*dyType);
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/bind-c06.f90

     integer :: z
   end type
 
+  type, bind(c) :: t10
+    !ERROR: Each component of an interoperable derived type must have an interoperable type
+    character(len=2) x
+  end type
+  type, bind(c) :: t11
+    !ERROR: Each component of an interoperable derived type must have an interoperable type
+    character(kind=2) x
+  end type
+  type, bind(c) :: t12
+    !ERROR: Each component of an interoperable derived type must have an interoperable type
+    logical(kind=8) x
+  end type
+  type, bind(c) :: t13
+    !ERROR: Each component of an interoperable derived type must have an interoperable type
+    real(kind=2) x
+  end type
+  type, bind(c) :: t14
+    !ERROR: Each component of an interoperable derived type must have an interoperable type
+    complex(kind=2) x
+  end type
+
 end