Re: Fix more of C/fortran canonical type issues

[Jan Hubicka <hubicka@ucw.cz>]

> On Thu, 8 Oct 2015, Jan Hubicka wrote:
> 
> > Hello,
> > here is updated version of the patch, this time without need to modify
> > useless_type_conversion.  Just to recall the issue, Fortran C interoperability
> > requires size_t to interoperate with signed version produced by Fortran FE.
> > Unlike the existing logic in aliasing that makes signed and unsigned share
> > alias sets this propagate up to the structures.  I.e. structure containing size_t
> > is interoperable with structure containing ptrdiff_t.
> 
> Hmm, note that size_t and ptrdiff_t do not have to have the same
> precision.  C11 just says size_t is the result of sizeof () and
> ptrdiff_t is the result of subtracting two pointers.  So instead
> of using BITS_PER_UNIT and POINTER_SIZE please look at the
> global C ABI types (size_type_node for size_t interoperability
> and char_type_node for char interoperability).

OK, I wll compare with TYPE_PRECISION of these.

> 
> Please skim over the testcases to see whether you falsely test
> interoperability of ptrdiff_t (I see at least intptr_t which
> would need an extra handling of TYPE_PRECISION equal to that
> of ptrdiff_type_node).

No, I only test size_t. I used ptrdiff_t only in the explanation letter ;)
The other types are just listing all integer types explicitely claimed
by the standard to be inter-operable.
> 
> As you duplicate the code in two places it would be nice to
> split this out into a function maybe?  
> integer_precisions_with_interoperable_signedness () (uh... ;))

Uhm, yep, that is a good idea. I will prepare updated patch after
fixing that Ada issue.

Honza
> 
> Ok with that change(s).
> 
> Thanks,
> Richard.
> 
> > Bootstrapped/regtested ppc64le-linux, OK?
> > 
> > Honza
> > 
> > 
> > 	* tree.c (gimple_canonical_types_compatible_p): Do not compare
> > 	TYPE_UNSIGNED for size_t and char compatible types.
> > 
> > 	* lto.c (hash_canonical_type): Do not hash TYPE_UNSIGNED for size_t
> > 	and char compatible 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.
> > 	* gfortran.dg/lto/bind_c-5_0.f90: New testcase.
> > 	* gfortran.dg/lto/bind_c-5_1.c: New testcase.
> > Index: lto/lto.c
> > ===================================================================
> > --- lto/lto.c	(revision 228586)
> > +++ lto/lto.c	(working copy)
> > @@ -288,6 +288,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
> > @@ -299,7 +300,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.  */
> > @@ -309,8 +311,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))
> > 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: testsuite/gfortran.dg/lto/bind_c-5_0.f90
> > ===================================================================
> > --- testsuite/gfortran.dg/lto/bind_c-5_0.f90	(revision 0)
> > +++ testsuite/gfortran.dg/lto/bind_c-5_0.f90	(working copy)
> > @@ -0,0 +1,17 @@
> > +! { dg-lto-do run }
> > +! { dg-lto-options {{ -O3 -flto }} }
> > +! This testcase will abort if C_FUNPTR is not interoperable with both int *
> > +! and float *
> > +module lto_type_merge_test
> > +  use, intrinsic :: iso_c_binding
> > +  implicit none
> > +
> > +  type(c_funptr), bind(c, name="myVar") :: myVar
> > +  type(c_funptr), bind(c, name="myVar2") :: myVar2
> > +
> > +contains
> > +  subroutine types_test() bind(c)
> > +    myVar = myVar2
> > +  end subroutine types_test
> > +end module lto_type_merge_test
> > +
> > Index: testsuite/gfortran.dg/lto/bind_c-5_1.c
> > ===================================================================
> > --- testsuite/gfortran.dg/lto/bind_c-5_1.c	(revision 0)
> > +++ testsuite/gfortran.dg/lto/bind_c-5_1.c	(working copy)
> > @@ -0,0 +1,31 @@
> > +#include <stdlib.h>
> > +/* declared in the fortran module */
> > +extern int (*myVar) (int);
> > +extern float (*myVar2) (float);
> > +void types_test(void);
> > +
> > +
> > +extern void abort(void);
> > +
> > +int main(int argc, char **argv)
> > +{
> > +   int (**myptr) (int);
> > +   float (**myptr2) (float);
> > +   asm("":"=r"(myptr):"0"(&myVar));
> > +   asm("":"=r"(myptr2):"0"(&myVar2));
> > +   *myptr = (int (*) (int)) (size_t) (void *)1;
> > +   *myptr2 = (float (*) (float)) (size_t) (void *)2;
> > +   types_test();
> > +   if (*myptr != (int (*) (int)) (size_t) (void *)2)
> > +	abort ();
> > +   if (*myptr2 != (float (*) (float)) (size_t) (void *)2)
> > +	abort ();
> > +   *myptr2 = (float (*) (float)) (size_t) (void *)3;
> > +   types_test();
> > +   if (*myptr != (int (*) (int)) (size_t) (void *)3)
> > +	abort ();
> > +   if (*myptr2 != (float (*) (float)) (size_t) (void *)3)
> > +	abort ();
> > +   return 0;
> > +}
> > +
> > Index: tree.c
> > ===================================================================
> > --- tree.c	(revision 228586)
> > +++ tree.c	(working copy)
> > @@ -13062,8 +13062,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.  */
> > @@ -13086,11 +13086,19 @@
> >        || 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;
> >  
> > +      /* 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))
> > +
> >        /* Fortran's C_SIGNED_CHAR is !TYPE_STRING_FLAG but needs to be
> >  	 interoperable with "signed char".  Unless all frontends are revisited
> >  	 to agree on these types, we must ignore the flag completely.  */
> > 
> > 
> 
> -- 
> Richard Biener <rguenther@suse.de>
> SUSE LINUX GmbH, GF: Felix Imendoerffer, Jane Smithard, Graham Norton, HRB 21284 (AG Nuernberg)