Add testcase for PR fortran/100906

2021-10-21  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
	    Sandra Loosemore  <sandra@codesourcery.com>

	gcc/testsuite/

	PR fortran/100906
	* gfortran.dg/PR100906.f90: New.
	* gfortran.dg/PR100906.c: New.

2 files changed, 1868 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/PR100906.c b/gcc/testsuite/gfortran.dg/PR100906.c
new file mode 100644
index 0000000..f71d5677
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100906.c
@@ -0,0 +1,169 @@
+/* Test the fix for PR100906 */
+
+#include <assert.h>
+#include <stdbool.h>
+#include <stdint.h>
+#include <stdio.h>
+/* #include <uchar.h> */
+
+#include <ISO_Fortran_binding.h>
+
+#define _CFI_type_mask 0xFF
+#define _CFI_type_kind_shift 8
+
+#define _CFI_decode_type(NAME) (signed char)((NAME) & CFI_type_mask)
+#define _CFI_decode_kind(NAME) (signed char)(((NAME) >> CFI_type_kind_shift) & CFI_type_mask)
+
+#define _CFI_encode_type(TYPE, KIND) (int16_t)\
+((((KIND) & CFI_type_mask) << CFI_type_kind_shift)\
+ | ((TYPE) & CFI_type_mask))
+
+#define N 11
+#define M 7
+
+typedef char c_char;
+/* typedef char32_t c_ucs4_char; */
+typedef uint32_t char32_t;
+typedef uint32_t c_ucs4_char;
+ 
+bool charcmp (char *, char, size_t);
+
+bool ucharcmp (char32_t *, char32_t, size_t);
+
+bool c_vrfy_c_char (const CFI_cdesc_t *restrict, const size_t);
+
+bool c_vrfy_c_ucs4_char (const CFI_cdesc_t *restrict, const size_t);
+
+bool c_vrfy_character (const CFI_cdesc_t *restrict, const size_t);
+ 
+void check_tk (const CFI_cdesc_t*restrict, const CFI_type_t, const signed char, const size_t, const size_t);
+
+bool
+charcmp (char *c, char v, size_t n)
+{
+  bool res = true;
+  char b = (char)'A';
+  size_t i;
+
+  for (i=0; ((i<n)&&(res)); i++, c++)
+    res = (*c == (v+b));
+  return res;
+}
+
+bool
+ucharcmp (char32_t *c, char32_t v, size_t n)
+{
+  bool res = true;
+  char32_t b = (char32_t)0xFF01;
+  size_t i;
+
+  for (i=0; ((i<n)&&(res)); i++, c++)
+    res = (*c == (v+b));
+  return res;
+}
+
+bool
+c_vrfy_c_char (const CFI_cdesc_t *restrict auxp, const size_t len)
+{
+  CFI_index_t i, lb, ub, ex;
+  size_t sz;
+  c_char *ip = NULL;
+
+  assert (auxp);
+  assert (auxp->base_addr);
+  assert (auxp->elem_len>0);
+  lb = auxp->dim[0].lower_bound;
+  ex = auxp->dim[0].extent;
+  assert (ex==N);
+  sz = (size_t)auxp->elem_len / sizeof (c_char);
+  assert (sz==len);
+  ub = ex + lb - 1;
+  ip = (c_char*)auxp->base_addr;
+  for (i=0; i<ex; i++, ip+=sz)
+    if (!charcmp (ip, (c_char)(i), sz))
+      return false;
+  for (i=lb; i<ub+1; i++)
+    {
+      ip = (c_char*)CFI_address(auxp, &i);
+      if (!charcmp (ip, (c_char)(i-lb), sz))
+	return false;
+    }
+  return true;
+}
+
+bool
+c_vrfy_c_ucs4_char (const CFI_cdesc_t *restrict auxp, const size_t len)
+{
+  CFI_index_t i, lb, ub, ex;
+  size_t sz;
+  c_ucs4_char *ip = NULL;
+
+  assert (auxp);
+  assert (auxp->base_addr);
+  assert (auxp->elem_len>0);
+  lb = auxp->dim[0].lower_bound;
+  ex = auxp->dim[0].extent;
+  assert (ex==N);
+  sz = (size_t)auxp->elem_len / sizeof (c_ucs4_char);
+  assert (sz==len);
+  ub = ex + lb - 1;
+  ip = (c_ucs4_char*)auxp->base_addr;
+  for (i=0; i<ex; i++, ip+=sz)
+    if (!ucharcmp (ip, (c_ucs4_char)(i), sz))
+      return false;
+  for (i=lb; i<ub+1; i++)
+    {
+      ip = (c_ucs4_char*)CFI_address(auxp, &i);
+      if (!ucharcmp (ip, (c_ucs4_char)(i-lb), sz))
+	return false;
+    }
+  return true;
+}
+
+bool
+c_vrfy_character (const CFI_cdesc_t *restrict auxp, const size_t len)
+{
+  signed char type, kind;
+  
+  assert (auxp);
+  type = _CFI_decode_type(auxp->type);
+  kind = _CFI_decode_kind(auxp->type);
+  assert (type == CFI_type_Character);
+  switch (kind)
+    {
+    case 1:
+      return c_vrfy_c_char (auxp, len);
+      break;
+    case 4:
+      return c_vrfy_c_ucs4_char (auxp, len);
+      break;
+    default:
+      assert (false);
+    }
+  return true;
+}
+
+void
+check_tk (const CFI_cdesc_t *restrict auxp, const CFI_type_t type, const signed char kind, const size_t elem_len, const size_t nelem)
+{
+  signed char ityp, iknd;
+
+  assert (auxp);
+  assert (auxp->elem_len==elem_len*nelem);
+  assert (auxp->rank==1);
+  assert (auxp->dim[0].sm>0);
+  assert ((size_t)auxp->dim[0].sm==elem_len*nelem);
+  /*  */
+  assert (auxp->type==type);
+  ityp = _CFI_decode_type(auxp->type);
+  assert (ityp == CFI_type_Character);
+  iknd = _CFI_decode_kind(auxp->type);
+  assert (_CFI_decode_type(type)==ityp);
+  assert (kind==iknd);
+  assert (c_vrfy_character (auxp, nelem));
+  return;
+}
+
+// Local Variables:
+// mode: C
+// End:
diff --git a/gcc/testsuite/gfortran.dg/PR100906.f90 b/gcc/testsuite/gfortran.dg/PR100906.f90
new file mode 100644
index 0000000..f6cb3af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100906.f90
@@ -0,0 +1,1699 @@
+! { dg-do run }
+! { dg-additional-sources PR100906.c }
+!
+! Test the fix for PR100906
+! 
+
+module isof_m
+
+  use, intrinsic :: iso_c_binding, only: &
+    c_signed_char, c_int16_t
+  
+  implicit none
+
+  private
+  
+  public ::             &
+    CFI_type_character
+
+  public ::             &
+    CFI_type_char,      &
+    CFI_type_ucs4_char
+ 
+  public ::      &
+    check_tk_as, &
+    check_tk_ar
+  
+  
+  public ::          &
+    cfi_encode_type
+  
+  integer, parameter :: CFI_type_t = c_int16_t
+  
+  integer(kind=c_int16_t), parameter :: CFI_type_mask = int(z"FF", kind=c_int16_t)
+  integer(kind=c_int16_t), parameter :: CFI_type_kind_shift = 8_c_int16_t
+
+  ! Intrinsic types. Their kind number defines their storage size. */
+  integer(kind=c_signed_char), parameter :: CFI_type_Character = 5
+
+  ! C-Fortran Interoperability types.
+  integer(kind=cfi_type_t), parameter :: CFI_type_char      = &
+    ior(int(CFI_type_Character, kind=c_int16_t), shiftl(1_c_int16_t, CFI_type_kind_shift))
+  integer(kind=cfi_type_t), parameter :: CFI_type_ucs4_char = &
+    ior(int(CFI_type_Character, kind=c_int16_t), shiftl(4_c_int16_t, CFI_type_kind_shift))
+
+  interface
+    subroutine check_tk_as(a, t, k, e, n) &
+      bind(c, name="check_tk")
+      use, intrinsic :: iso_c_binding, only: &
+        c_int16_t, c_signed_char, c_size_t
+      implicit none
+      type(*),                       intent(in) :: a(:)
+      integer(c_int16_t),     value, intent(in) :: t
+      integer(c_signed_char), value, intent(in) :: k
+      integer(c_size_t),      value, intent(in) :: e
+      integer(c_size_t),      value, intent(in) :: n
+    end subroutine check_tk_as
+    subroutine check_tk_ar(a, t, k, e, n) &
+      bind(c, name="check_tk")
+      use, intrinsic :: iso_c_binding, only: &
+        c_int16_t, c_signed_char, c_size_t
+      implicit none
+      type(*),                       intent(in) :: a(..)
+      integer(c_int16_t),     value, intent(in) :: t
+      integer(c_signed_char), value, intent(in) :: k
+      integer(c_size_t),      value, intent(in) :: e
+      integer(c_size_t),      value, intent(in) :: n
+    end subroutine check_tk_ar
+  end interface
+
+contains
+
+  elemental function cfi_encode_type(type, kind) result(itype)
+    integer(kind=c_signed_char), intent(in) :: type
+    integer(kind=c_signed_char), intent(in) :: kind
+
+    integer(kind=c_int16_t) :: itype, ikind
+
+    itype = int(type, kind=c_int16_t)
+    itype = iand(itype, CFI_type_mask)
+    ikind = int(kind, kind=c_int16_t)
+    ikind = iand(ikind, CFI_type_mask)
+    ikind = shiftl(ikind, CFI_type_kind_shift)
+    itype = ior(ikind, itype)
+    return
+  end function cfi_encode_type
+  
+end module isof_m
+
+module iso_check_m
+
+  use, intrinsic :: iso_c_binding, only: &
+    c_signed_char, c_int16_t, c_size_t
+
+  use, intrinsic :: iso_c_binding, only: &
+    c_char
+
+  use :: isof_m, only:  &
+    CFI_type_character
+
+  use :: isof_m, only:  &
+    CFI_type_char,      &
+    CFI_type_ucs4_char
+
+  use :: isof_m, only: &
+    check_tk_as,       &
+    check_tk_ar
+
+  use :: isof_m, only: &
+    cfi_encode_type
+
+  implicit none
+
+  private
+
+  public ::               &
+    check_c_char_l1,      &
+    check_c_char_lm,      &
+    check_c_ucs4_char_l1, &
+    check_c_ucs4_char_lm
+  
+  integer                           :: i
+  integer(kind=c_size_t), parameter :: b = 8
+  integer,                parameter :: n = 11
+  integer,                parameter :: m = 7
+  
+  integer, parameter :: c_ucs4_char = 4
+  
+  character(kind=c_char, len=1), parameter :: ref_c_char_l1(*) = &
+    [(achar(i+iachar("A")-1, kind=c_char), i=1,n)]
+  character(kind=c_char, len=m), parameter :: ref_c_char_lm(*) = &
+    [(repeat(achar(i+iachar("A")-1, kind=c_char), m), i=1,n)]
+  character(kind=c_ucs4_char, len=1), parameter :: ref_c_ucs4_char_l1(*) = &
+    [(achar(i+iachar("A")-1, kind=c_ucs4_char), i=1,n)]
+  character(kind=c_ucs4_char, len=m), parameter :: ref_c_ucs4_char_lm(*) = &
+    [(repeat(achar(i+iachar("A")-1, kind=c_ucs4_char), m), i=1,n)]
+
+contains
+
+  subroutine check_c_char_l1()
+    character(kind=c_char, len=1), target :: a(n)
+    !
+    character(kind=c_char, len=:), pointer :: p(:)
+    !
+    a = ref_c_char_l1
+    call f_check_c_char_c1_as(a)
+    if(any(a/=ref_c_char_l1)) stop 1
+    a = ref_c_char_l1
+    call c_check_c_char_c1_as(a)
+    if(any(a/=ref_c_char_l1)) stop 2
+    a = ref_c_char_l1
+    call f_check_c_char_c1_ar(a)
+    if(any(a/=ref_c_char_l1)) stop 3
+    a = ref_c_char_l1
+    call c_check_c_char_c1_ar(a)
+    if(any(a/=ref_c_char_l1)) stop 4
+    a = ref_c_char_l1
+    call f_check_c_char_a1_as(a)
+    if(any(a/=ref_c_char_l1)) stop 5
+    a = ref_c_char_l1
+    call c_check_c_char_a1_as(a)
+    if(any(a/=ref_c_char_l1)) stop 6
+    a = ref_c_char_l1
+    call f_check_c_char_a1_ar(a)
+    if(any(a/=ref_c_char_l1)) stop 7
+    a = ref_c_char_l1
+    call c_check_c_char_a1_ar(a)
+    if(any(a/=ref_c_char_l1)) stop 8
+    a = ref_c_char_l1
+    p => a  
+    call f_check_c_char_d1_as(p)
+    if(.not.associated(p)) stop 9
+    if(.not.associated(p, a)) stop 10
+    if(any(p/=ref_c_char_l1)) stop 11
+    if(any(a/=ref_c_char_l1)) stop 12
+    a = ref_c_char_l1
+    p => a  
+    call c_check_c_char_d1_as(p)
+    if(.not.associated(p)) stop 13
+    if(.not.associated(p, a)) stop 14
+    if(any(p/=ref_c_char_l1)) stop 15
+    if(any(a/=ref_c_char_l1)) stop 16
+    a = ref_c_char_l1
+    p => a  
+    call f_check_c_char_d1_ar(p)
+    if(.not.associated(p)) stop 17
+    if(.not.associated(p, a)) stop 18
+    if(any(p/=ref_c_char_l1)) stop 19
+    if(any(a/=ref_c_char_l1)) stop 20
+    a = ref_c_char_l1
+    p => a  
+    call c_check_c_char_d1_ar(p)
+    if(.not.associated(p)) stop 21
+    if(.not.associated(p, a)) stop 22
+    if(any(p/=ref_c_char_l1)) stop 23
+    if(any(a/=ref_c_char_l1)) stop 24
+    return
+  end subroutine check_c_char_l1
+
+  subroutine f_check_c_char_c1_as(a)
+    character(kind=c_char, len=1), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 25
+    if(k/=1_c_signed_char) stop 26
+    if(n/=1) stop 27
+    if(int(k, kind=c_size_t)/=e) stop 28
+    if(t/=CFI_type_char) stop 29
+    if(any(a/=ref_c_char_l1)) stop 30
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_l1)) stop 31
+    return
+  end subroutine f_check_c_char_c1_as
+
+  subroutine c_check_c_char_c1_as(a) bind(c)
+    character(kind=c_char, len=1), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 32
+    if(k/=1_c_signed_char) stop 33
+    if(n/=1) stop 34
+    if(int(k, kind=c_size_t)/=e) stop 35
+    if(t/=CFI_type_char) stop 36
+    if(any(a/=ref_c_char_l1)) stop 37
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_l1)) stop 38
+    return
+  end subroutine c_check_c_char_c1_as
+
+  subroutine f_check_c_char_c1_ar(a)
+    character(kind=c_char, len=1), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 39
+    if(k/=1_c_signed_char) stop 40
+    if(n/=1) stop 41
+    if(int(k, kind=c_size_t)/=e) stop 42
+    if(t/=CFI_type_char) stop 43
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 44
+    rank default
+      stop 45
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 46
+    rank default
+      stop 47
+    end select
+    return
+  end subroutine f_check_c_char_c1_ar
+
+  subroutine c_check_c_char_c1_ar(a) bind(c)
+    character(kind=c_char, len=1), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 48
+    if(k/=1_c_signed_char) stop 49
+    if(n/=1) stop 50
+    if(int(k, kind=c_size_t)/=e) stop 51
+    if(t/=CFI_type_char) stop 52
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 53
+    rank default
+      stop 54
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 55
+    rank default
+      stop 56
+    end select
+    return
+  end subroutine c_check_c_char_c1_ar
+
+  subroutine f_check_c_char_a1_as(a)
+    character(kind=c_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 57
+    if(k/=1_c_signed_char) stop 58
+    if(n/=1) stop 59
+    if(int(k, kind=c_size_t)/=e) stop 60
+    if(t/=CFI_type_char) stop 61
+    if(any(a/=ref_c_char_l1)) stop 62
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_l1)) stop 63
+    return
+  end subroutine f_check_c_char_a1_as
+
+  subroutine c_check_c_char_a1_as(a) bind(c)
+    character(kind=c_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 64
+    if(k/=1_c_signed_char) stop 65
+    if(n/=1) stop 66
+    if(int(k, kind=c_size_t)/=e) stop 67
+    if(t/=CFI_type_char) stop 68
+    if(any(a/=ref_c_char_l1)) stop 69
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_l1)) stop 70
+    return
+  end subroutine c_check_c_char_a1_as
+
+  subroutine f_check_c_char_a1_ar(a)
+    character(kind=c_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 71
+    if(k/=1_c_signed_char) stop 72
+    if(n/=1) stop 73
+    if(int(k, kind=c_size_t)/=e) stop 74
+    if(t/=CFI_type_char) stop 75
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 76
+    rank default
+      stop 77
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 78
+    rank default
+      stop 79
+    end select
+    return
+  end subroutine f_check_c_char_a1_ar
+
+  subroutine c_check_c_char_a1_ar(a) bind(c)
+    character(kind=c_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 80
+    if(k/=1_c_signed_char) stop 81
+    if(n/=1) stop 82
+    if(int(k, kind=c_size_t)/=e) stop 83
+    if(t/=CFI_type_char) stop 84
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 85
+    rank default
+      stop 86
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 87
+    rank default
+      stop 88
+    end select
+    return
+  end subroutine c_check_c_char_a1_ar
+
+  subroutine f_check_c_char_d1_as(a)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 89
+    if(k/=1_c_signed_char) stop 90
+    if(n/=1) stop 91
+    if(int(k, kind=c_size_t)/=e) stop 92
+    if(t/=CFI_type_char) stop 93
+    if(any(a/=ref_c_char_l1)) stop 94
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_l1)) stop 95
+    return
+  end subroutine f_check_c_char_d1_as
+
+  subroutine c_check_c_char_d1_as(a) bind(c)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 96
+    if(k/=1_c_signed_char) stop 97
+    if(n/=1) stop 98
+    if(int(k, kind=c_size_t)/=e) stop 99
+    if(t/=CFI_type_char) stop 100
+    if(any(a/=ref_c_char_l1)) stop 101
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_l1)) stop 102
+    return
+  end subroutine c_check_c_char_d1_as
+
+  subroutine f_check_c_char_d1_ar(a)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 103
+    if(k/=1_c_signed_char) stop 104
+    if(n/=1) stop 105
+    if(int(k, kind=c_size_t)/=e) stop 106
+    if(t/=CFI_type_char) stop 107
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 108
+    rank default
+      stop 109
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 110
+    rank default
+      stop 111
+    end select
+    return
+  end subroutine f_check_c_char_d1_ar
+
+  subroutine c_check_c_char_d1_ar(a) bind(c)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 112
+    if(k/=1_c_signed_char) stop 113
+    if(n/=1) stop 114
+    if(int(k, kind=c_size_t)/=e) stop 115
+    if(t/=CFI_type_char) stop 116
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 117
+    rank default
+      stop 118
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_l1)) stop 119
+    rank default
+      stop 120
+    end select
+    return
+  end subroutine c_check_c_char_d1_ar
+
+  subroutine check_c_char_lm()
+    character(kind=c_char, len=m), target :: a(n)
+    !
+    character(kind=c_char, len=:), pointer :: p(:)
+    !
+    a = ref_c_char_lm
+    call f_check_c_char_cm_as(a)
+    if(any(a/=ref_c_char_lm)) stop 121
+    a = ref_c_char_lm
+    call c_check_c_char_cm_as(a)
+    if(any(a/=ref_c_char_lm)) stop 122
+    a = ref_c_char_lm
+    call f_check_c_char_cm_ar(a)
+    if(any(a/=ref_c_char_lm)) stop 123
+    a = ref_c_char_lm
+    call c_check_c_char_cm_ar(a)
+    if(any(a/=ref_c_char_lm)) stop 124
+    a = ref_c_char_lm
+    call f_check_c_char_am_as(a)
+    if(any(a/=ref_c_char_lm)) stop 125
+    a = ref_c_char_lm
+    call c_check_c_char_am_as(a)
+    if(any(a/=ref_c_char_lm)) stop 126
+    a = ref_c_char_lm
+    call f_check_c_char_am_ar(a)
+    if(any(a/=ref_c_char_lm)) stop 127
+    a = ref_c_char_lm
+    call c_check_c_char_am_ar(a)
+    if(any(a/=ref_c_char_lm)) stop 128
+    a = ref_c_char_lm
+    p => a  
+    call f_check_c_char_dm_as(p)
+    if(.not.associated(p)) stop 129
+    if(.not.associated(p, a)) stop 130
+    if(any(p/=ref_c_char_lm)) stop 131
+    if(any(a/=ref_c_char_lm)) stop 132
+    a = ref_c_char_lm
+    p => a  
+    call c_check_c_char_dm_as(p)
+    if(.not.associated(p)) stop 133
+    if(.not.associated(p, a)) stop 134
+    if(any(p/=ref_c_char_lm)) stop 135
+    if(any(a/=ref_c_char_lm)) stop 136
+    a = ref_c_char_lm
+    p => a  
+    call f_check_c_char_dm_ar(p)
+    if(.not.associated(p)) stop 137
+    if(.not.associated(p, a)) stop 138
+    if(any(p/=ref_c_char_lm)) stop 139
+    if(any(a/=ref_c_char_lm)) stop 140
+    a = ref_c_char_lm
+    p => a  
+    call c_check_c_char_dm_ar(p)
+    if(.not.associated(p)) stop 141
+    if(.not.associated(p, a)) stop 142
+    if(any(p/=ref_c_char_lm)) stop 143
+    if(any(a/=ref_c_char_lm)) stop 144
+    return
+  end subroutine check_c_char_lm
+
+  subroutine f_check_c_char_cm_as(a)
+    character(kind=c_char, len=m), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 145
+    if(k/=1_c_signed_char) stop 146
+    if(n/=m) stop 147
+    if(int(k, kind=c_size_t)/=e) stop 148
+    if(t/=CFI_type_char) stop 149
+    if(any(a/=ref_c_char_lm)) stop 150
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_lm)) stop 151
+    return
+  end subroutine f_check_c_char_cm_as
+
+  subroutine c_check_c_char_cm_as(a) bind(c)
+    character(kind=c_char, len=m), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 152
+    if(k/=1_c_signed_char) stop 153
+    if(n/=m) stop 154
+    if(int(k, kind=c_size_t)/=e) stop 155
+    if(t/=CFI_type_char) stop 156
+    if(any(a/=ref_c_char_lm)) stop 157
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_lm)) stop 158
+    return
+  end subroutine c_check_c_char_cm_as
+
+  subroutine f_check_c_char_cm_ar(a)
+    character(kind=c_char, len=m), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 159
+    if(k/=1_c_signed_char) stop 160
+    if(n/=m) stop 161
+    if(int(k, kind=c_size_t)/=e) stop 162
+    if(t/=CFI_type_char) stop 163
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 164
+    rank default
+      stop 165
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 166
+    rank default
+      stop 167
+    end select
+    return
+  end subroutine f_check_c_char_cm_ar
+
+  subroutine c_check_c_char_cm_ar(a) bind(c)
+    character(kind=c_char, len=m), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 168
+    if(k/=1_c_signed_char) stop 169
+    if(n/=m) stop 170
+    if(int(k, kind=c_size_t)/=e) stop 171
+    if(t/=CFI_type_char) stop 172
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 173
+    rank default
+      stop 174
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 175
+    rank default
+      stop 176
+    end select
+    return
+  end subroutine c_check_c_char_cm_ar
+
+  subroutine f_check_c_char_am_as(a)
+    character(kind=c_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 177
+    if(k/=1_c_signed_char) stop 178
+    if(n/=m) stop 179
+    if(int(k, kind=c_size_t)/=e) stop 180
+    if(t/=CFI_type_char) stop 181
+    if(any(a/=ref_c_char_lm)) stop 182
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_lm)) stop 183
+    return
+  end subroutine f_check_c_char_am_as
+
+  subroutine c_check_c_char_am_as(a) bind(c)
+    character(kind=c_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 184
+    if(k/=1_c_signed_char) stop 185
+    if(n/=m) stop 186
+    if(int(k, kind=c_size_t)/=e) stop 187
+    if(t/=CFI_type_char) stop 188
+    if(any(a/=ref_c_char_lm)) stop 189
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_lm)) stop 190
+    return
+  end subroutine c_check_c_char_am_as
+
+  subroutine f_check_c_char_am_ar(a)
+    character(kind=c_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 191
+    if(k/=1_c_signed_char) stop 192
+    if(n/=m) stop 193
+    if(int(k, kind=c_size_t)/=e) stop 194
+    if(t/=CFI_type_char) stop 195
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 196
+    rank default
+      stop 197
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 198
+    rank default
+      stop 199
+    end select
+    return
+  end subroutine f_check_c_char_am_ar
+
+  subroutine c_check_c_char_am_ar(a) bind(c)
+    character(kind=c_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 200
+    if(k/=1_c_signed_char) stop 201
+    if(n/=m) stop 202
+    if(int(k, kind=c_size_t)/=e) stop 203
+    if(t/=CFI_type_char) stop 204
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 205
+    rank default
+      stop 206
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 207
+    rank default
+      stop 208
+    end select
+    return
+  end subroutine c_check_c_char_am_ar
+
+  subroutine f_check_c_char_dm_as(a)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 209
+    if(k/=1_c_signed_char) stop 210
+    if(n/=m) stop 211
+    if(int(k, kind=c_size_t)/=e) stop 212
+    if(t/=CFI_type_char) stop 213
+    if(any(a/=ref_c_char_lm)) stop 214
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_lm)) stop 215
+    return
+  end subroutine f_check_c_char_dm_as
+
+  subroutine c_check_c_char_dm_as(a) bind(c)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 216
+    if(k/=1_c_signed_char) stop 217
+    if(n/=m) stop 218
+    if(int(k, kind=c_size_t)/=e) stop 219
+    if(t/=CFI_type_char) stop 220
+    if(any(a/=ref_c_char_lm)) stop 221
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_char_lm)) stop 222
+    return
+  end subroutine c_check_c_char_dm_as
+
+  subroutine f_check_c_char_dm_ar(a)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 223
+    if(k/=1_c_signed_char) stop 224
+    if(n/=m) stop 225
+    if(int(k, kind=c_size_t)/=e) stop 226
+    if(t/=CFI_type_char) stop 227
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 228
+    rank default
+      stop 229
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 230
+    rank default
+      stop 231
+    end select
+    return
+  end subroutine f_check_c_char_dm_ar
+
+  subroutine c_check_c_char_dm_ar(a) bind(c)
+    character(kind=c_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 232
+    if(k/=1_c_signed_char) stop 233
+    if(n/=m) stop 234
+    if(int(k, kind=c_size_t)/=e) stop 235
+    if(t/=CFI_type_char) stop 236
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 237
+    rank default
+      stop 238
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_char_lm)) stop 239
+    rank default
+      stop 240
+    end select
+    return
+  end subroutine c_check_c_char_dm_ar
+
+  subroutine check_c_ucs4_char_l1()
+    character(kind=c_ucs4_char, len=1), target :: a(n)
+    !
+    character(kind=c_ucs4_char, len=:), pointer :: p(:)
+    !
+    a = ref_c_ucs4_char_l1
+    call f_check_c_ucs4_char_c1_as(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 241
+    a = ref_c_ucs4_char_l1
+    call c_check_c_ucs4_char_c1_as(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 242
+    a = ref_c_ucs4_char_l1
+    call f_check_c_ucs4_char_c1_ar(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 243
+    a = ref_c_ucs4_char_l1
+    call c_check_c_ucs4_char_c1_ar(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 244
+    a = ref_c_ucs4_char_l1
+    call f_check_c_ucs4_char_a1_as(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 245
+    a = ref_c_ucs4_char_l1
+    call c_check_c_ucs4_char_a1_as(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 246
+    a = ref_c_ucs4_char_l1
+    call f_check_c_ucs4_char_a1_ar(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 247
+    a = ref_c_ucs4_char_l1
+    call c_check_c_ucs4_char_a1_ar(a)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 248
+    a = ref_c_ucs4_char_l1
+    p => a  
+    call f_check_c_ucs4_char_d1_as(p)
+    if(.not.associated(p)) stop 249
+    if(.not.associated(p, a)) stop 250
+    if(any(p/=ref_c_ucs4_char_l1)) stop 251
+    if(any(a/=ref_c_ucs4_char_l1)) stop 252
+    a = ref_c_ucs4_char_l1
+    p => a  
+    call c_check_c_ucs4_char_d1_as(p)
+    if(.not.associated(p)) stop 253
+    if(.not.associated(p, a)) stop 254
+    if(any(p/=ref_c_ucs4_char_l1)) stop 255
+    if(any(a/=ref_c_ucs4_char_l1)) stop 256
+    a = ref_c_ucs4_char_l1
+    p => a  
+    call f_check_c_ucs4_char_d1_ar(p)
+    if(.not.associated(p)) stop 257
+    if(.not.associated(p, a)) stop 258
+    if(any(p/=ref_c_ucs4_char_l1)) stop 259
+    if(any(a/=ref_c_ucs4_char_l1)) stop 260
+    a = ref_c_ucs4_char_l1
+    p => a  
+    call c_check_c_ucs4_char_d1_ar(p)
+    if(.not.associated(p)) stop 261
+    if(.not.associated(p, a)) stop 262
+    if(any(p/=ref_c_ucs4_char_l1)) stop 263
+    if(any(a/=ref_c_ucs4_char_l1)) stop 264
+    return
+  end subroutine check_c_ucs4_char_l1
+
+  subroutine f_check_c_ucs4_char_c1_as(a)
+    character(kind=c_ucs4_char, len=1), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 265
+    if(k/=4_c_signed_char) stop 266
+    if(n/=1) stop 267
+    if(int(k, kind=c_size_t)/=e) stop 268
+    if(t/=CFI_type_ucs4_char) stop 269
+    if(any(a/=ref_c_ucs4_char_l1)) stop 270
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 271
+    return
+  end subroutine f_check_c_ucs4_char_c1_as
+
+  subroutine c_check_c_ucs4_char_c1_as(a) bind(c)
+    character(kind=c_ucs4_char, len=1), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 272
+    if(k/=4_c_signed_char) stop 273
+    if(n/=1) stop 274
+    if(int(k, kind=c_size_t)/=e) stop 275
+    if(t/=CFI_type_ucs4_char) stop 276
+    if(any(a/=ref_c_ucs4_char_l1)) stop 277
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 278
+    return
+  end subroutine c_check_c_ucs4_char_c1_as
+
+  subroutine f_check_c_ucs4_char_c1_ar(a)
+    character(kind=c_ucs4_char, len=1), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 279
+    if(k/=4_c_signed_char) stop 280
+    if(n/=1) stop 281
+    if(int(k, kind=c_size_t)/=e) stop 282
+    if(t/=CFI_type_ucs4_char) stop 283
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 284
+    rank default
+      stop 285
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 286
+    rank default
+      stop 287
+    end select
+    return
+  end subroutine f_check_c_ucs4_char_c1_ar
+
+  subroutine c_check_c_ucs4_char_c1_ar(a) bind(c)
+    character(kind=c_ucs4_char, len=1), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 288
+    if(k/=4_c_signed_char) stop 289
+    if(n/=1) stop 290
+    if(int(k, kind=c_size_t)/=e) stop 291
+    if(t/=CFI_type_ucs4_char) stop 292
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 293
+    rank default
+      stop 294
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 295
+    rank default
+      stop 296
+    end select
+    return
+  end subroutine c_check_c_ucs4_char_c1_ar
+
+  subroutine f_check_c_ucs4_char_a1_as(a)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 297
+    if(k/=4_c_signed_char) stop 298
+    if(n/=1) stop 299
+    if(int(k, kind=c_size_t)/=e) stop 300
+    if(t/=CFI_type_ucs4_char) stop 301
+    if(any(a/=ref_c_ucs4_char_l1)) stop 302
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 303
+    return
+  end subroutine f_check_c_ucs4_char_a1_as
+
+  subroutine c_check_c_ucs4_char_a1_as(a) bind(c)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 304
+    if(k/=4_c_signed_char) stop 305
+    if(n/=1) stop 306
+    if(int(k, kind=c_size_t)/=e) stop 307
+    if(t/=CFI_type_ucs4_char) stop 308
+    if(any(a/=ref_c_ucs4_char_l1)) stop 309
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 310
+    return
+  end subroutine c_check_c_ucs4_char_a1_as
+
+  subroutine f_check_c_ucs4_char_a1_ar(a)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 311
+    if(k/=4_c_signed_char) stop 312
+    if(n/=1) stop 313
+    if(int(k, kind=c_size_t)/=e) stop 314
+    if(t/=CFI_type_ucs4_char) stop 315
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 316
+    rank default
+      stop 317
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 318
+    rank default
+      stop 319
+    end select
+    return
+  end subroutine f_check_c_ucs4_char_a1_ar
+
+  subroutine c_check_c_ucs4_char_a1_ar(a) bind(c)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 320
+    if(k/=4_c_signed_char) stop 321
+    if(n/=1) stop 322
+    if(int(k, kind=c_size_t)/=e) stop 323
+    if(t/=CFI_type_ucs4_char) stop 324
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 325
+    rank default
+      stop 326
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 327
+    rank default
+      stop 328
+    end select
+    return
+  end subroutine c_check_c_ucs4_char_a1_ar
+
+  subroutine f_check_c_ucs4_char_d1_as(a)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 329
+    if(k/=4_c_signed_char) stop 330
+    if(n/=1) stop 331
+    if(int(k, kind=c_size_t)/=e) stop 332
+    if(t/=CFI_type_ucs4_char) stop 333
+    if(any(a/=ref_c_ucs4_char_l1)) stop 334
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 335
+    return
+  end subroutine f_check_c_ucs4_char_d1_as
+
+  subroutine c_check_c_ucs4_char_d1_as(a) bind(c)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 336
+    if(k/=4_c_signed_char) stop 337
+    if(n/=1) stop 338
+    if(int(k, kind=c_size_t)/=e) stop 339
+    if(t/=CFI_type_ucs4_char) stop 340
+    if(any(a/=ref_c_ucs4_char_l1)) stop 341
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_l1)) stop 342
+    return
+  end subroutine c_check_c_ucs4_char_d1_as
+
+  subroutine f_check_c_ucs4_char_d1_ar(a)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 343
+    if(k/=4_c_signed_char) stop 344
+    if(n/=1) stop 345
+    if(int(k, kind=c_size_t)/=e) stop 346
+    if(t/=CFI_type_ucs4_char) stop 347
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 348
+    rank default
+      stop 349
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 350
+    rank default
+      stop 351
+    end select
+    return
+  end subroutine f_check_c_ucs4_char_d1_ar
+
+  subroutine c_check_c_ucs4_char_d1_ar(a) bind(c)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*1)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 352
+    if(k/=4_c_signed_char) stop 353
+    if(n/=1) stop 354
+    if(int(k, kind=c_size_t)/=e) stop 355
+    if(t/=CFI_type_ucs4_char) stop 356
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 357
+    rank default
+      stop 358
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_l1)) stop 359
+    rank default
+      stop 360
+    end select
+    return
+  end subroutine c_check_c_ucs4_char_d1_ar
+
+  subroutine check_c_ucs4_char_lm()
+    character(kind=c_ucs4_char, len=m), target :: a(n)
+    !
+    character(kind=c_ucs4_char, len=:), pointer :: p(:)
+    !
+    a = ref_c_ucs4_char_lm
+    call f_check_c_ucs4_char_cm_as(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 361
+    a = ref_c_ucs4_char_lm
+    call c_check_c_ucs4_char_cm_as(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 362
+    a = ref_c_ucs4_char_lm
+    call f_check_c_ucs4_char_cm_ar(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 363
+    a = ref_c_ucs4_char_lm
+    call c_check_c_ucs4_char_cm_ar(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 364
+    a = ref_c_ucs4_char_lm
+    call f_check_c_ucs4_char_am_as(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 365
+    a = ref_c_ucs4_char_lm
+    call c_check_c_ucs4_char_am_as(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 366
+    a = ref_c_ucs4_char_lm
+    call f_check_c_ucs4_char_am_ar(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 367
+    a = ref_c_ucs4_char_lm
+    call c_check_c_ucs4_char_am_ar(a)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 368
+    a = ref_c_ucs4_char_lm
+    p => a  
+    call f_check_c_ucs4_char_dm_as(p)
+    if(.not.associated(p)) stop 369
+    if(.not.associated(p, a)) stop 370
+    if(any(p/=ref_c_ucs4_char_lm)) stop 371
+    if(any(a/=ref_c_ucs4_char_lm)) stop 372
+    a = ref_c_ucs4_char_lm
+    p => a  
+    call c_check_c_ucs4_char_dm_as(p)
+    if(.not.associated(p)) stop 373
+    if(.not.associated(p, a)) stop 374
+    if(any(p/=ref_c_ucs4_char_lm)) stop 375
+    if(any(a/=ref_c_ucs4_char_lm)) stop 376
+    a = ref_c_ucs4_char_lm
+    p => a  
+    call f_check_c_ucs4_char_dm_ar(p)
+    if(.not.associated(p)) stop 377
+    if(.not.associated(p, a)) stop 378
+    if(any(p/=ref_c_ucs4_char_lm)) stop 379
+    if(any(a/=ref_c_ucs4_char_lm)) stop 380
+    a = ref_c_ucs4_char_lm
+    p => a  
+    call c_check_c_ucs4_char_dm_ar(p)
+    if(.not.associated(p)) stop 381
+    if(.not.associated(p, a)) stop 382
+    if(any(p/=ref_c_ucs4_char_lm)) stop 383
+    if(any(a/=ref_c_ucs4_char_lm)) stop 384
+    return
+  end subroutine check_c_ucs4_char_lm
+
+  subroutine f_check_c_ucs4_char_cm_as(a)
+    character(kind=c_ucs4_char, len=m), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 385
+    if(k/=4_c_signed_char) stop 386
+    if(n/=m) stop 387
+    if(int(k, kind=c_size_t)/=e) stop 388
+    if(t/=CFI_type_ucs4_char) stop 389
+    if(any(a/=ref_c_ucs4_char_lm)) stop 390
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 391
+    return
+  end subroutine f_check_c_ucs4_char_cm_as
+
+  subroutine c_check_c_ucs4_char_cm_as(a) bind(c)
+    character(kind=c_ucs4_char, len=m), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 392
+    if(k/=4_c_signed_char) stop 393
+    if(n/=m) stop 394
+    if(int(k, kind=c_size_t)/=e) stop 395
+    if(t/=CFI_type_ucs4_char) stop 396
+    if(any(a/=ref_c_ucs4_char_lm)) stop 397
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 398
+    return
+  end subroutine c_check_c_ucs4_char_cm_as
+
+  subroutine f_check_c_ucs4_char_cm_ar(a)
+    character(kind=c_ucs4_char, len=m), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 399
+    if(k/=4_c_signed_char) stop 400
+    if(n/=m) stop 401
+    if(int(k, kind=c_size_t)/=e) stop 402
+    if(t/=CFI_type_ucs4_char) stop 403
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 404
+    rank default
+      stop 405
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 406
+    rank default
+      stop 407
+    end select
+    return
+  end subroutine f_check_c_ucs4_char_cm_ar
+
+  subroutine c_check_c_ucs4_char_cm_ar(a) bind(c)
+    character(kind=c_ucs4_char, len=m), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 408
+    if(k/=4_c_signed_char) stop 409
+    if(n/=m) stop 410
+    if(int(k, kind=c_size_t)/=e) stop 411
+    if(t/=CFI_type_ucs4_char) stop 412
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 413
+    rank default
+      stop 414
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 415
+    rank default
+      stop 416
+    end select
+    return
+  end subroutine c_check_c_ucs4_char_cm_ar
+
+  subroutine f_check_c_ucs4_char_am_as(a)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 417
+    if(k/=4_c_signed_char) stop 418
+    if(n/=m) stop 419
+    if(int(k, kind=c_size_t)/=e) stop 420
+    if(t/=CFI_type_ucs4_char) stop 421
+    if(any(a/=ref_c_ucs4_char_lm)) stop 422
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 423
+    return
+  end subroutine f_check_c_ucs4_char_am_as
+
+  subroutine c_check_c_ucs4_char_am_as(a) bind(c)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 424
+    if(k/=4_c_signed_char) stop 425
+    if(n/=m) stop 426
+    if(int(k, kind=c_size_t)/=e) stop 427
+    if(t/=CFI_type_ucs4_char) stop 428
+    if(any(a/=ref_c_ucs4_char_lm)) stop 429
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 430
+    return
+  end subroutine c_check_c_ucs4_char_am_as
+
+  subroutine f_check_c_ucs4_char_am_ar(a)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 431
+    if(k/=4_c_signed_char) stop 432
+    if(n/=m) stop 433
+    if(int(k, kind=c_size_t)/=e) stop 434
+    if(t/=CFI_type_ucs4_char) stop 435
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 436
+    rank default
+      stop 437
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 438
+    rank default
+      stop 439
+    end select
+    return
+  end subroutine f_check_c_ucs4_char_am_ar
+
+  subroutine c_check_c_ucs4_char_am_ar(a) bind(c)
+    character(kind=c_ucs4_char, len=*), intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 440
+    if(k/=4_c_signed_char) stop 441
+    if(n/=m) stop 442
+    if(int(k, kind=c_size_t)/=e) stop 443
+    if(t/=CFI_type_ucs4_char) stop 444
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 445
+    rank default
+      stop 446
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 447
+    rank default
+      stop 448
+    end select
+    return
+  end subroutine c_check_c_ucs4_char_am_ar
+
+  subroutine f_check_c_ucs4_char_dm_as(a)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 449
+    if(k/=4_c_signed_char) stop 450
+    if(n/=m) stop 451
+    if(int(k, kind=c_size_t)/=e) stop 452
+    if(t/=CFI_type_ucs4_char) stop 453
+    if(any(a/=ref_c_ucs4_char_lm)) stop 454
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 455
+    return
+  end subroutine f_check_c_ucs4_char_dm_as
+
+  subroutine c_check_c_ucs4_char_dm_as(a) bind(c)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(:)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 456
+    if(k/=4_c_signed_char) stop 457
+    if(n/=m) stop 458
+    if(int(k, kind=c_size_t)/=e) stop 459
+    if(t/=CFI_type_ucs4_char) stop 460
+    if(any(a/=ref_c_ucs4_char_lm)) stop 461
+    call check_tk_as(a, t, k, e, n)
+    if(any(a/=ref_c_ucs4_char_lm)) stop 462
+    return
+  end subroutine c_check_c_ucs4_char_dm_as
+
+  subroutine f_check_c_ucs4_char_dm_ar(a)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 463
+    if(k/=4_c_signed_char) stop 464
+    if(n/=m) stop 465
+    if(int(k, kind=c_size_t)/=e) stop 466
+    if(t/=CFI_type_ucs4_char) stop 467
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 468
+    rank default
+      stop 469
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 470
+    rank default
+      stop 471
+    end select
+    return
+  end subroutine f_check_c_ucs4_char_dm_ar
+
+  subroutine c_check_c_ucs4_char_dm_ar(a) bind(c)
+    character(kind=c_ucs4_char, len=:), pointer, intent(in) :: a(..)
+    !
+    integer(kind=c_int16_t)     :: t
+    integer(kind=c_signed_char) :: k
+    integer(kind=c_size_t)      :: e, n
+    !
+    k = kind(a)
+    n = len(a, kind=kind(e))
+    e = storage_size(a, kind=kind(e))/(b*m)
+    t = cfi_encode_type(CFI_type_Character, k)
+    if(k<=0_c_signed_char) stop 472
+    if(k/=4_c_signed_char) stop 473
+    if(n/=m) stop 474
+    if(int(k, kind=c_size_t)/=e) stop 475
+    if(t/=CFI_type_ucs4_char) stop 476
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 477
+    rank default
+      stop 478
+    end select
+    call check_tk_ar(a, t, k, e, n)
+    select rank(a)
+    rank(1)
+      if(any(a/=ref_c_ucs4_char_lm)) stop 479
+    rank default
+      stop 480
+    end select
+    return
+  end subroutine c_check_c_ucs4_char_dm_ar
+  
+end module iso_check_m
+
+program main_p
+  
+  use :: iso_check_m, only: &
+    check_c_char_l1,        &
+    check_c_char_lm,        &
+    check_c_ucs4_char_l1,   &
+    check_c_ucs4_char_lm
+
+  implicit none
+
+  call check_c_char_l1()
+  call check_c_char_lm()
+  ! See PR100907
+  !call check_c_ucs4_char_l1()
+  !call check_c_ucs4_char_lm()
+  stop
+
+end program main_p
+
+!! Local Variables:
+!! mode: f90
+!! End:
+