PR100906 ("Bind(c): failure handling character with len/=1") has been
fixed by Tobias's rewrite of the GFC <-> C descriptor conversions. I'd
like to add José's testcase for that issue before closing it. OK?
-Sandra
commit 4c2fa9cf74162015710ccfd913c827779151aa52
Author: Sandra Loosemore
Date: Thu Oct 21 19:17:50 2021 -0700
Add testcase for PR fortran/100906
2021-10-21 José Rui Faustino de Sousa
Sandra Loosemore
gcc/testsuite/
PR fortran/100906
* gfortran.dg/PR100906.f90: New.
* gfortran.dg/PR100906.c: New.
diff --git a/gcc/testsuite/gfortran.dg/PR100906.c b/gcc/testsuite/gfortran.dg/PR100906.c
new file mode 100644
index 000..f71d567
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR100906.c
@@ -0,0 +1,169 @@
+/* Test the fix for PR100906 */
+
+#include
+#include
+#include
+#include
+/* #include */
+
+#include
+
+#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; ((ibase_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; ibase_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; itype);
+ 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 000..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,
