This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Fix more of C/fortran canonical type issues


Hi,
this patchs makes fortran's C_SIGNED_CHAR and C_SIZE_T interoperable with 
signed char and size_t as standard require.  There are two issues here.

First Fortran integers are always signed, but the standard insist on the
signed integer to match C size_t that is unsigned (if it was ptrdiff_t, we would
be better of) and similarly the standard seems to explicitly state that
C_SIGNED_CHAR is interoperable with both signed char and unsigned char.
I thus globbed all integer types of precision compatible either with char
or size_t to be the same regardless the signedness.

These types are special and apparently magic.  I wonder if C FE can be adjusted
to make these unsigned instead, but I have no idea if that could possibly work.

I also had to update useless_type_conversion_p here and move INTEGER_CST
handling ahead so it does not ignore sign.  The patch got handled in ugly way
by diff, it only moves the whole block on INTEGER_CST up.

The second problem is that Fortran FE does not set STRING_FLAG for
C_SIGNED_CHAR while C frontend do. I suppose we can teach Fortran to set the
flag, but again I do not know what consequences that would have.

I thus dropped STRING_FLAG from the canonical type computation.  It is already
ignored by gimple_canonical_types_compatible_p.  My understanding is that
STRING_FLAG on integer types is only kind of support to define the array types
anyway. The wrong code can be reproduced by uncommenging the char part of
bind_c-4 testcase.

Finally I added testcases for all types of 15.3.2 of the fortran 2008 draft.
I found that C_CHAR is not really compatible with char because it is
declared as array of chars. Lets handle that incrementally.

Bootstrapped/regtested ppc64le-linux, seems sane?

	* gimple-expr.c (useless_type_conversion_p): Move
	INTEGER_TYPE handling ahead.
	* tree.c (gimple_canonical_types_compatible_p): Do not compare
	TYPE_UNSIGNED for size_t and char compatible types; do not hash
	STRING_FLAG on integer types.

	* lto.c (hash_canonical_type): Do not hash TYPE_UNSIGNED for size_t
	and char compatible types; do not hash STRING_FLAG on integer types.

	* gfortran.dg/lto/bind_c-2_0.f90: New testcase.
	* gfortran.dg/lto/bind_c-2_1.c: New testcase.
	* gfortran.dg/lto/bind_c-3_0.f90: New testcase.
	* gfortran.dg/lto/bind_c-3_1.c: New testcase.
	* gfortran.dg/lto/bind_c-4_0.f90: New testcase.
	* gfortran.dg/lto/bind_c-4_1.c: New testcase.
Index: gimple-expr.c
===================================================================
--- gimple-expr.c	(revision 224201)
+++ gimple-expr.c	(working copy)
@@ -91,30 +91,14 @@
 	       || TREE_CODE (TREE_TYPE (inner_type)) == METHOD_TYPE))
 	return false;
     }
-
-  /* From now on qualifiers on value types do not matter.  */
-  inner_type = TYPE_MAIN_VARIANT (inner_type);
-  outer_type = TYPE_MAIN_VARIANT (outer_type);
-
-  if (inner_type == outer_type)
-    return true;
-
-  /* If we know the canonical types, compare them.  */
-  if (TYPE_CANONICAL (inner_type)
-      && TYPE_CANONICAL (inner_type) == TYPE_CANONICAL (outer_type))
-    return true;
-
-  /* Changes in machine mode are never useless conversions unless we
-     deal with aggregate types in which case we defer to later checks.  */
-  if (TYPE_MODE (inner_type) != TYPE_MODE (outer_type)
-      && !AGGREGATE_TYPE_P (inner_type))
-    return false;
-
   /* If both the inner and outer types are integral types, then the
      conversion is not necessary if they have the same mode and
-     signedness and precision, and both or neither are boolean.  */
-  if (INTEGRAL_TYPE_P (inner_type)
-      && INTEGRAL_TYPE_P (outer_type))
+     signedness and precision, and both or neither are boolean.
+
+     Do not rely on TYPE_CANONICAL here because LTO puts same canonical
+     type for signed char and unsigned char.  */
+  else if (INTEGRAL_TYPE_P (inner_type)
+           && INTEGRAL_TYPE_P (outer_type))
     {
       /* Preserve changes in signedness or precision.  */
       if (TYPE_UNSIGNED (inner_type) != TYPE_UNSIGNED (outer_type)
@@ -134,6 +118,25 @@
       return true;
     }
 
+
+  /* From now on qualifiers on value types do not matter.  */
+  inner_type = TYPE_MAIN_VARIANT (inner_type);
+  outer_type = TYPE_MAIN_VARIANT (outer_type);
+
+  if (inner_type == outer_type)
+    return true;
+
+  /* If we know the canonical types, compare them.  */
+  if (TYPE_CANONICAL (inner_type)
+      && TYPE_CANONICAL (inner_type) == TYPE_CANONICAL (outer_type))
+    return true;
+
+  /* Changes in machine mode are never useless conversions unless we
+     deal with aggregate types in which case we defer to later checks.  */
+  if (TYPE_MODE (inner_type) != TYPE_MODE (outer_type)
+      && !AGGREGATE_TYPE_P (inner_type))
+    return false;
+
   /* Scalar floating point types with the same mode are compatible.  */
   else if (SCALAR_FLOAT_TYPE_P (inner_type)
 	   && SCALAR_FLOAT_TYPE_P (outer_type))
Index: lto/lto.c
===================================================================
--- lto/lto.c	(revision 224201)
+++ lto/lto.c	(working copy)
@@ -303,6 +303,7 @@
 hash_canonical_type (tree type)
 {
   inchash::hash hstate;
+  enum tree_code code;
 
   /* We compute alias sets only for types that needs them.
      Be sure we do not recurse to something else as we can not hash incomplete
@@ -314,7 +315,8 @@
      smaller sets; when searching for existing matching types to merge,
      only existing types having the same features as the new type will be
      checked.  */
-  hstate.add_int (tree_code_for_canonical_type_merging (TREE_CODE (type)));
+  code = tree_code_for_canonical_type_merging (TREE_CODE (type));
+  hstate.add_int (code);
   hstate.add_int (TYPE_MODE (type));
 
   /* Incorporate common features of numerical types.  */
@@ -324,8 +326,15 @@
       || TREE_CODE (type) == OFFSET_TYPE
       || POINTER_TYPE_P (type))
     {
-      hstate.add_int (TYPE_UNSIGNED (type));
       hstate.add_int (TYPE_PRECISION (type));
+      /* Ignore sign for char and size_t.  This is needed for fortran
+	 C_SIGNED_CHAR to be interoperable with both signed char and
+	 unsigned char (as stadnard requires).  Similarly fortran FE builds
+	 C_SIZE_T is signed type, while C defines it unsigned.  */
+      if (code != INTEGER_TYPE
+	  || (TYPE_PRECISION (type) != BITS_PER_UNIT
+	      && TYPE_PRECISION (type) != POINTER_SIZE))
+        hstate.add_int (TYPE_UNSIGNED (type));
     }
 
   if (VECTOR_TYPE_P (type))
@@ -345,9 +354,9 @@
       hstate.add_int (TYPE_ADDR_SPACE (TREE_TYPE (type)));
     }
 
-  /* For integer types hash only the string flag.  */
-  if (TREE_CODE (type) == INTEGER_TYPE)
-    hstate.add_int (TYPE_STRING_FLAG (type));
+  /* Fortran FE does not set string flag for C_SIGNED_CHAR while C
+     sets it for signed char.  To use STRING_FLAG to define canonical types,
+     the frontends would need to agree.  */
 
   /* For array types hash the domain bounds and the string flag.  */
   if (TREE_CODE (type) == ARRAY_TYPE && TYPE_DOMAIN (type))
Index: testsuite/gfortran.dg/lto/bind_c-2_0.f90
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-2_0.f90	(revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-2_0.f90	(working copy)
@@ -0,0 +1,21 @@
+! { dg-lto-do run }
+! { dg-lto-options {{ -O3 -flto }} }
+! This testcase will abort if C_PTR is not interoperable with both int *
+! and float *
+module lto_type_merge_test
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  type, bind(c) :: MYFTYPE_1
+     integer(c_signed_char) :: chr
+     integer(c_signed_char) :: chrb
+  end type MYFTYPE_1
+
+  type(myftype_1), bind(c, name="myVar") :: myVar
+
+contains
+  subroutine types_test() bind(c)
+    myVar%chr = myVar%chrb
+  end subroutine types_test
+end module lto_type_merge_test
+
Index: testsuite/gfortran.dg/lto/bind_c-2_1.c
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-2_1.c	(revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-2_1.c	(working copy)
@@ -0,0 +1,36 @@
+#include <stdlib.h>
+/* interopse with myftype_1 */
+typedef struct {
+   unsigned char chr;
+   signed char chr2;
+} myctype_t;
+
+
+extern void abort(void);
+void types_test(void);
+/* declared in the fortran module */
+extern myctype_t myVar;
+
+int main(int argc, char **argv)
+{
+   myctype_t *cchr;
+   asm("":"=r"(cchr):"0"(&myVar));
+   cchr->chr = 1;
+   cchr->chr2 = 2;
+
+   types_test();
+
+   if(cchr->chr != 2)
+      abort();
+   if(cchr->chr2 != 2)
+      abort();
+   myVar.chr2 = 3;
+   types_test();
+
+   if(myVar.chr != 3)
+      abort();
+   if(myVar.chr2 != 3)
+      abort();
+   return 0;
+}
+
Index: testsuite/gfortran.dg/lto/bind_c-3_0.f90
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-3_0.f90	(revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-3_0.f90	(working copy)
@@ -0,0 +1,91 @@
+! { dg-lto-do run }
+! { dg-lto-options {{ -O3 -flto }} }
+! This testcase will abort if integer types are not interoperable.
+module lto_type_merge_test
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  type, bind(c) :: MYFTYPE_1
+    integer(c_int) :: val_int
+    integer(c_short) :: val_short
+    integer(c_long) :: val_long
+    integer(c_long_long) :: val_long_long
+    integer(c_size_t) :: val_size_t
+    integer(c_int8_t) :: val_int8_t
+    integer(c_int16_t) :: val_int16_t
+    integer(c_int32_t) :: val_int32_t
+    integer(c_int64_t) :: val_int64_t
+    integer(c_int_least8_t) :: val_intleast_8_t
+    integer(c_int_least16_t) :: val_intleast_16_t
+    integer(c_int_least32_t) :: val_intleast_32_t
+    integer(c_int_least64_t) :: val_intleast_64_t
+    integer(c_int_fast8_t) :: val_intfast_8_t
+    integer(c_int_fast16_t) :: val_intfast_16_t
+    integer(c_int_fast32_t) :: val_intfast_32_t
+    integer(c_int_fast64_t) :: val_intfast_64_t
+    integer(c_intmax_t) :: val_intmax_t
+    integer(c_intptr_t) :: val_intptr_t
+  end type MYFTYPE_1
+
+  type(myftype_1), bind(c, name="myVar") :: myVar
+
+contains
+  subroutine types_test1() bind(c)
+    myVar%val_int = 2
+  end subroutine types_test1
+  subroutine types_test2() bind(c)
+    myVar%val_short = 2
+  end subroutine types_test2
+  subroutine types_test3() bind(c)
+    myVar%val_long = 2
+  end subroutine types_test3
+  subroutine types_test4() bind(c)
+    myVar%val_long_long = 2
+  end subroutine types_test4
+  subroutine types_test5() bind(c)
+    myVar%val_size_t = 2
+  end subroutine types_test5
+  subroutine types_test6() bind(c)
+    myVar%val_int8_t = 2
+  end subroutine types_test6
+  subroutine types_test7() bind(c)
+    myVar%val_int16_t = 2
+  end subroutine types_test7
+  subroutine types_test8() bind(c)
+    myVar%val_int32_t = 2
+  end subroutine types_test8
+  subroutine types_test9() bind(c)
+    myVar%val_int64_t = 2
+  end subroutine types_test9
+  subroutine types_test10() bind(c)
+    myVar%val_intleast_8_t = 2
+  end subroutine types_test10
+  subroutine types_test11() bind(c)
+    myVar%val_intleast_16_t = 2
+  end subroutine types_test11
+  subroutine types_test12() bind(c)
+    myVar%val_intleast_32_t = 2
+  end subroutine types_test12
+  subroutine types_test13() bind(c)
+    myVar%val_intleast_64_t = 2
+  end subroutine types_test13
+  subroutine types_test14() bind(c)
+    myVar%val_intfast_8_t = 2
+  end subroutine types_test14
+  subroutine types_test15() bind(c)
+    myVar%val_intfast_16_t = 2
+  end subroutine types_test15
+  subroutine types_test16() bind(c)
+    myVar%val_intfast_32_t = 2
+  end subroutine types_test16
+  subroutine types_test17() bind(c)
+    myVar%val_intfast_64_t = 2
+  end subroutine types_test17
+  subroutine types_test18() bind(c)
+    myVar%val_intmax_t = 2
+  end subroutine types_test18
+  subroutine types_test19() bind(c)
+    myVar%val_intptr_t = 2
+  end subroutine types_test19
+end module lto_type_merge_test
+
Index: testsuite/gfortran.dg/lto/bind_c-3_1.c
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-3_1.c	(revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-3_1.c	(working copy)
@@ -0,0 +1,78 @@
+#include <stdlib.h>
+#include <stdint.h>
+/* interopse with myftype_1 */
+typedef struct {
+  int val1;
+  short int val2;
+  long int val3;
+  long long int val4;
+  size_t val5;
+  int8_t val6;
+  int16_t val7;
+  int32_t val8;
+  int64_t val9;
+  int_least8_t val10;
+  int_least16_t val11;
+  int_least32_t val12;
+  int_least64_t val13;
+  int_fast8_t val14;
+  int_fast16_t val15;
+  int_fast32_t val16;
+  int_fast64_t val17;
+  intmax_t val18;
+  intptr_t val19;
+} myctype_t;
+
+
+extern void abort(void);
+void types_test1(void);
+void types_test2(void);
+void types_test3(void);
+void types_test4(void);
+void types_test5(void);
+void types_test6(void);
+void types_test7(void);
+void types_test8(void);
+void types_test9(void);
+void types_test10(void);
+void types_test11(void);
+void types_test12(void);
+void types_test13(void);
+void types_test14(void);
+void types_test15(void);
+void types_test16(void);
+void types_test17(void);
+void types_test18(void);
+void types_test19(void);
+/* declared in the fortran module */
+extern myctype_t myVar;
+
+#define test(n)\
+  cchr->val##n = 1; types_test##n (); if (cchr->val##n != 2) abort ();
+
+int main(int argc, char **argv)
+{
+   myctype_t *cchr;
+   asm("":"=r"(cchr):"0"(&myVar));
+   test(1);
+   test(2);
+   test(3);
+   test(4);
+   test(5);
+   test(6);
+   test(7);
+   test(8);
+   test(9);
+   test(10);
+   test(11);
+   test(12);
+   test(13);
+   test(14);
+   test(15);
+   test(16);
+   test(17);
+   test(18);
+   test(19);
+   return 0;
+}
+
Index: testsuite/gfortran.dg/lto/bind_c-4_0.f90
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-4_0.f90	(revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-4_0.f90	(working copy)
@@ -0,0 +1,48 @@
+! { dg-lto-do run }
+! { dg-lto-options {{ -O3 -flto }} }
+! This testcase will abort if real/complex/boolean/character types are not interoperable
+module lto_type_merge_test
+  use, intrinsic :: iso_c_binding
+  implicit none
+
+  type, bind(c) :: MYFTYPE_1
+    real(c_float) :: val_1
+    real(c_double) :: val_2
+    real(c_long_double) :: val_3
+    complex(c_float_complex) :: val_4
+    complex(c_double_complex) :: val_5
+    complex(c_long_double_complex) :: val_6
+    logical(c_bool) :: val_7
+    !FIXME: Fortran define c_char as array of size 1.
+    !character(c_char) :: val_8
+  end type MYFTYPE_1
+
+  type(myftype_1), bind(c, name="myVar") :: myVar
+
+contains
+  subroutine types_test1() bind(c)
+    myVar%val_1 = 2
+  end subroutine types_test1
+  subroutine types_test2() bind(c)
+    myVar%val_2 = 2
+  end subroutine types_test2
+  subroutine types_test3() bind(c)
+    myVar%val_3 = 2
+  end subroutine types_test3
+  subroutine types_test4() bind(c)
+    myVar%val_4 = 2
+  end subroutine types_test4
+  subroutine types_test5() bind(c)
+    myVar%val_5 = 2
+  end subroutine types_test5
+  subroutine types_test6() bind(c)
+    myVar%val_6 = 2
+  end subroutine types_test6
+  subroutine types_test7() bind(c)
+    myVar%val_7 = myVar%val_7 .or. .not. myVar%val_7
+  end subroutine types_test7
+  !subroutine types_test8() bind(c)
+    !myVar%val_8 = "a"
+  !end subroutine types_test8
+end module lto_type_merge_test
+
Index: testsuite/gfortran.dg/lto/bind_c-4_1.c
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-4_1.c	(revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-4_1.c	(working copy)
@@ -0,0 +1,46 @@
+#include <stdlib.h>
+#include <stdint.h>
+/* interopse with myftype_1 */
+typedef struct {
+  float val1;
+  double val2;
+  long double val3;
+  float _Complex val4;
+  double _Complex val5;
+  long double _Complex val6;
+  _Bool val7;
+  /* FIXME: Fortran define c_char as array of size 1.
+     char val8;  */
+} myctype_t;
+
+
+extern void abort(void);
+void types_test1(void);
+void types_test2(void);
+void types_test3(void);
+void types_test4(void);
+void types_test5(void);
+void types_test6(void);
+void types_test7(void);
+void types_test8(void);
+/* declared in the fortran module */
+extern myctype_t myVar;
+
+#define test(n)\
+  cchr->val##n = 1; types_test##n (); if (cchr->val##n != 2) abort ();
+
+int main(int argc, char **argv)
+{
+   myctype_t *cchr;
+   asm("":"=r"(cchr):"0"(&myVar));
+   test(1);
+   test(2);
+   test(3);
+   test(4);
+   test(5);
+   test(6);
+   cchr->val7 = 0; types_test7 (); if (cchr->val7 != 1) abort ();
+   /*cchr->val8 = 0; types_test8 (); if (cchr->val8 != 'a') abort ();*/
+   return 0;
+}
+
Index: tree.c
===================================================================
--- tree.c	(revision 224201)
+++ tree.c	(working copy)
@@ -12925,8 +12925,8 @@
     return TYPE_CANONICAL (t1) == TYPE_CANONICAL (t2);
 
   /* Can't be the same type if the types don't have the same code.  */
-  if (tree_code_for_canonical_type_merging (TREE_CODE (t1))
-      != tree_code_for_canonical_type_merging (TREE_CODE (t2)))
+  enum tree_code code = tree_code_for_canonical_type_merging (TREE_CODE (t1));
+  if (code != tree_code_for_canonical_type_merging (TREE_CODE (t2)))
     return false;
 
   /* Qualifiers do not matter for canonical type comparison purposes.  */
@@ -12949,15 +12949,23 @@
       || TREE_CODE (t1) == OFFSET_TYPE
       || POINTER_TYPE_P (t1))
     {
-      /* Can't be the same type if they have different sign or precision.  */
-      if (TYPE_PRECISION (t1) != TYPE_PRECISION (t2)
-	  || TYPE_UNSIGNED (t1) != TYPE_UNSIGNED (t2))
+      /* Can't be the same type if they have different recision.  */
+      if (TYPE_PRECISION (t1) != TYPE_PRECISION (t2))
 	return false;
-
-      if (TREE_CODE (t1) == INTEGER_TYPE
-	  && TYPE_STRING_FLAG (t1) != TYPE_STRING_FLAG (t2))
+      /* Ignore sign for char and size_t.  This is needed for fortran
+	 C_SIGNED_CHAR to be interoperable with both signed char and
+	 unsigned char (as stadnard requires).  Similarly fortran FE builds
+	 C_SIZE_T is signed type, while C defines it unsigned.  */
+      if (TYPE_UNSIGNED (t1) != TYPE_UNSIGNED (t2)
+	  && ((TYPE_PRECISION (t1) != BITS_PER_UNIT
+	       && TYPE_PRECISION (t1) != POINTER_SIZE)
+	      || code != INTEGER_TYPE))
 	return false;
 
+      /* Fortran FE does not set STRING_FLAG for C_SIGNED_CHAR while C
+	 sets it for signed char.  To use string flag to define canonical
+	 types, the frontends would need to agree.  */
+
       /* Fortran standard define C_PTR type that is compatible with every
  	 C pointer.  For this reason we need to glob all pointers into one.
 	 Still pointers in different address spaces are not compatible.  */


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]