Re: Fix more of C/fortran canonical type issues

[Jan Hubicka <hubicka@ucw.cz>]

> > On Mon, 8 Jun 2015, Jan Hubicka wrote:
> > 
> > > > 
> > > > I think we should instead work towards eliminating the get_alias_set
> > > > langhook first.  The LTO langhook variant contains the same handling, btw,
> > > > so just inline that into get_alias_set and see what remains?
> > > 
> > > I see, i completely missed existence of gimple_get_alias_set. It makes more
> > > sense now.
> > > 
> > > Is moving everyting to alias.c realy a desirable thing? If non-C languages do
> > > not have this rule, why we want to reduce the code quality when compiling
> > > those?
> > 
> > Well, for consistency and for getting rid of one langhook ;)
> :)
> In a way this particular langhook makes sense to me - TBAA rules are language specific.
> We also may with explicit streaming of the TBAA dag, like LLVM does.
> 
> Anyway, this is the updated patch fixing the Fortran's interoperability with
> size_t and signed char.  I will send separate patch for the extra lto-symtab
> warnings shortly.
> 
> I will be happy looking into the TYPE_CANONICAL (int) to be different from
> TYPE_CANONICAL (unsigned int) if that seems desirable. There are two things that
> needs to be solved - hash_canonical_type/gimple_canonical_types_compatible_p can't
> use TYPE_CNAONICAL of subtypes in all cases (that is easy) and we will need some
> way to recognize the conflict in lto-symtab other thanjust comparing TYPE_CANONICAL
> to not warn when a variable is declared signed in Fortran unit and unsigned in C.
> 
> Bootstrapped/regtested ppc64le-linux.
> 
> 	* lto/lto.c (hash_canonical_type): Do not hash TYPE_UNSIGNED
> 	of INTEGER_TYPE.
> 	* tree.c (gimple_canonical_types_compatible_p): Do not compare TYPE_UNSIGNED
> 	of INTEGER_TYPE.
> 	* gimple-expr.c (useless_type_conversion_p): Move INTEGER type handling
> 	ahead the canonical type lookup.
> 
> 	* 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

Hello,
I would like to ping this.  I am almost done with reviewing the Fortran's interoperability
issues.  I think the only two remaining problems is the CHARACTER(C_CHAR) and the fact
that Fortran explicitly sates that arrays are interoperable regardless their bounds
(just sizes):

NOTE 15.17
  For example, a Fortran array declared as
    INTEGER(C_INT) :: A(18, 3:7, *)
  is interoperable with a C array declared as
    int b[][5][18];

Honza

> Index: lto/lto.c
> ===================================================================
> --- lto/lto.c	(revision 224252)
> +++ lto/lto.c	(working copy)
> @@ -298,6 +298,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
> @@ -309,7 +310,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.  */
> @@ -319,7 +321,14 @@
>        || TREE_CODE (type) == OFFSET_TYPE
>        || POINTER_TYPE_P (type))
>      {
> -      hstate.add_int (TYPE_UNSIGNED (type));
> +      /* Some Fortran integer types are interoperable with C types regardless
> +	 their signedness.  We need to ignore sign on these to make it
> +	 possible for structure containing unsigned type to interoperate
> +	 with structure containing signed type which is also required by
> +	 the standard.  It is thus not enough to keep alias set of signed
> +	 type same with alias set of unsigned type.  */
> +      if (code != INTEGER_TYPE)
> +        hstate.add_int (TYPE_UNSIGNED (type));
>        hstate.add_int (TYPE_PRECISION (type));
>      }
>  
> Index: tree.c
> ===================================================================
> --- tree.c	(revision 224252)
> +++ tree.c	(working copy)
> @@ -12879,6 +12879,7 @@
>  gimple_canonical_types_compatible_p (const_tree t1, const_tree t2,
>  				     bool trust_type_canonical)
>  {
> +  enum tree_code code;
>    /* Type variants should be same as the main variant.  When not doing sanity
>       checking to verify this fact, go to main variants and save some work.  */
>    if (trust_type_canonical)
> @@ -12918,9 +12919,9 @@
>        && trust_type_canonical)
>      return TYPE_CANONICAL (t1) == TYPE_CANONICAL (t2);
>  
> +  code = tree_code_for_canonical_type_merging (TREE_CODE (t1));
>    /* 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)))
> +  if (code != tree_code_for_canonical_type_merging (TREE_CODE (t2)))
>      return false;
>  
>    /* Qualifiers do not matter for canonical type comparison purposes.  */
> @@ -12945,7 +12946,14 @@
>      {
>        /* 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))
> +	  /* Some Fortran integer types are interoperable with C types
> +	     regardless their signedness.  We need to ignore sign on these to
> +	     make it possible for structure containing unsigned type to
> +	     interoperate with structure containing signed type which is also
> +	     required by the standard.  It is thus not enough to keep alias set
> +	     of signed type same with alias set of unsigned type.  */
> +	  || (code != INTEGER_TYPE
> +	      && TYPE_UNSIGNED (t1) != TYPE_UNSIGNED (t2)))
>  	return false;
>  
>        /* Fortran's C_SIGNED_CHAR is !TYPE_STRING_FLAG but needs to be
> 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: gimple-expr.c
> ===================================================================
> --- gimple-expr.c	(revision 224250)
> +++ gimple-expr.c	(working copy)
> @@ -89,18 +89,6 @@
>  	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)
> @@ -131,6 +119,18 @@
>        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;
> +
>    /* Scalar floating point types with the same mode are compatible.  */
>    else if (SCALAR_FLOAT_TYPE_P (inner_type)
>  	   && SCALAR_FLOAT_TYPE_P (outer_type))