tree.c (type_with_interoperable_signedness): New.

* tree.c (type_with_interoperable_signedness): New.
	(gimple_canonical_types_compatible_p): Use it.
	* tree.h (type_with_interoperable_signedness): Declare

	* lto.c (hash_canonical_type): Honor
	type_with_interoperable_signedness.

	* 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.

From-SVN: r228680
This commit is contained in:
Jan Hubicka 2015-10-10 21:43:49 +02:00 committed by Jan Hubicka
parent 05486daafd
commit 9c4eeafc11
13 changed files with 417 additions and 7 deletions

View File

@ -1,3 +1,8 @@
2015-10-10 Jan Hubicka <hubicka@ucw.cz>
* lto.c (hash_canonical_type): Honor
type_with_interoperable_signedness.
2015-09-28 Nathan Sidwell <nathan@codesourcery.com>
* lto-lang.c (DEF_FUNCTION_TYPE_VAR_6): New.

View File

@ -288,6 +288,7 @@ static hashval_t
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 @@ hash_canonical_type (tree type)
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,9 @@ hash_canonical_type (tree type)
|| TREE_CODE (type) == OFFSET_TYPE
|| POINTER_TYPE_P (type))
{
hstate.add_int (TYPE_UNSIGNED (type));
hstate.add_int (TYPE_PRECISION (type));
if (!type_with_interoperable_signedness (type))
hstate.add_int (TYPE_UNSIGNED (type));
}
if (VECTOR_TYPE_P (type))

View File

@ -1,3 +1,14 @@
2015-10-10 Jan Hubicka <hubicka@ucw.cz>
* 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.
2015-10-09 Steve Ellcey <sellcey@imgtec.com>
* gcc.target/mips/mips.exp (mips_option_groups): Add -mframe-header-opt

View File

@ -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

View File

@ -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;
}

View File

@ -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

View File

@ -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;
}

View File

@ -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

View File

@ -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;
}

View File

@ -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

View File

@ -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;
}

View File

@ -13012,6 +13012,23 @@ verify_type_variant (const_tree t, tree tv)
back to pointer-comparison of TYPE_CANONICAL for aggregates
for example. */
/* Return true if TYPE_UNSIGNED of TYPE should be ignored for canonical
type calculation because we need to allow inter-operability between signed
and unsigned variants. */
bool
type_with_interoperable_signedness (const_tree type)
{
/* Fortran standard require C_SIGNED_CHAR to be interoperable with both
signed char and unsigned char. Similarly fortran FE builds
C_SIZE_T as signed type, while C defines it unsigned. */
return tree_code_for_canonical_type_merging (TREE_CODE (type))
== INTEGER_TYPE
&& (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node)
|| TYPE_PRECISION (type) == TYPE_PRECISION (size_type_node));
}
/* Return true iff T1 and T2 are structurally identical for what
TBAA is concerned.
This function is used both by lto.c canonical type merging and by the
@ -13062,8 +13079,8 @@ gimple_canonical_types_compatible_p (const_tree t1, const_tree t2,
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,9 +13103,14 @@ gimple_canonical_types_compatible_p (const_tree t1, const_tree t2,
|| 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;
/* In some cases the signed and unsigned types are required to be
inter-operable. */
if (TYPE_UNSIGNED (t1) != TYPE_UNSIGNED (t2)
&& !type_with_interoperable_signedness (t1))
return false;
/* Fortran's C_SIGNED_CHAR is !TYPE_STRING_FLAG but needs to be

View File

@ -4609,6 +4609,7 @@ extern int tree_map_base_marked_p (const void *);
extern void DEBUG_FUNCTION verify_type (const_tree t);
extern bool gimple_canonical_types_compatible_p (const_tree, const_tree,
bool trust_type_canonical = true);
extern bool type_with_interoperable_signedness (const_tree);
/* Return simplified tree code of type that is used for canonical type merging. */
inline enum tree_code
tree_code_for_canonical_type_merging (enum tree_code code)