From 9c4eeafc11dbd996949b3a0c3f5196e7c45ef92f Mon Sep 17 00:00:00 2001 From: Jan Hubicka Date: Sat, 10 Oct 2015 21:43:49 +0200 Subject: 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 --- gcc/lto/ChangeLog | 5 ++ gcc/lto/lto.c | 7 ++- gcc/testsuite/ChangeLog | 11 ++++ gcc/testsuite/gfortran.dg/lto/bind_c-2_0.f90 | 21 +++++++ gcc/testsuite/gfortran.dg/lto/bind_c-2_1.c | 36 +++++++++++ gcc/testsuite/gfortran.dg/lto/bind_c-3_0.f90 | 91 ++++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/lto/bind_c-3_1.c | 78 ++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/lto/bind_c-4_0.f90 | 48 +++++++++++++++ gcc/testsuite/gfortran.dg/lto/bind_c-4_1.c | 46 ++++++++++++++ gcc/testsuite/gfortran.dg/lto/bind_c-5_0.f90 | 17 ++++++ gcc/testsuite/gfortran.dg/lto/bind_c-5_1.c | 31 ++++++++++ gcc/tree.c | 32 ++++++++-- gcc/tree.h | 1 + 13 files changed, 417 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-2_0.f90 create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-2_1.c create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-3_0.f90 create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-3_1.c create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-4_0.f90 create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-4_1.c create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-5_0.f90 create mode 100644 gcc/testsuite/gfortran.dg/lto/bind_c-5_1.c diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog index 265f5f8..e75b4ea 100644 --- a/gcc/lto/ChangeLog +++ b/gcc/lto/ChangeLog @@ -1,3 +1,8 @@ +2015-10-10 Jan Hubicka + + * lto.c (hash_canonical_type): Honor + type_with_interoperable_signedness. + 2015-09-28 Nathan Sidwell * lto-lang.c (DEF_FUNCTION_TYPE_VAR_6): New. diff --git a/gcc/lto/lto.c b/gcc/lto/lto.c index 4bb0aaf..76f8e07 100644 --- a/gcc/lto/lto.c +++ b/gcc/lto/lto.c @@ -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)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d73a902..b558a9e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2015-10-10 Jan Hubicka + + * 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 * gcc.target/mips/mips.exp (mips_option_groups): Add -mframe-header-opt diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-2_0.f90 b/gcc/testsuite/gfortran.dg/lto/bind_c-2_0.f90 new file mode 100644 index 0000000..8ac2fd4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-2_0.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-2_1.c b/gcc/testsuite/gfortran.dg/lto/bind_c-2_1.c new file mode 100644 index 0000000..22ec591 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-2_1.c @@ -0,0 +1,36 @@ +#include +/* 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; +} + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-3_0.f90 b/gcc/testsuite/gfortran.dg/lto/bind_c-3_0.f90 new file mode 100644 index 0000000..e969eef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-3_0.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-3_1.c b/gcc/testsuite/gfortran.dg/lto/bind_c-3_1.c new file mode 100644 index 0000000..5c4835c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-3_1.c @@ -0,0 +1,78 @@ +#include +#include +/* 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; +} + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-4_0.f90 b/gcc/testsuite/gfortran.dg/lto/bind_c-4_0.f90 new file mode 100644 index 0000000..2dadb38 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-4_0.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-4_1.c b/gcc/testsuite/gfortran.dg/lto/bind_c-4_1.c new file mode 100644 index 0000000..2e2a3e3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-4_1.c @@ -0,0 +1,46 @@ +#include +#include +/* 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; +} + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-5_0.f90 b/gcc/testsuite/gfortran.dg/lto/bind_c-5_0.f90 new file mode 100644 index 0000000..836db09 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-5_0.f90 @@ -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 + diff --git a/gcc/testsuite/gfortran.dg/lto/bind_c-5_1.c b/gcc/testsuite/gfortran.dg/lto/bind_c-5_1.c new file mode 100644 index 0000000..6a0eb03 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/lto/bind_c-5_1.c @@ -0,0 +1,31 @@ +#include +/* 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; +} + diff --git a/gcc/tree.c b/gcc/tree.c index f78a2c2..02f0a7a 100644 --- a/gcc/tree.c +++ b/gcc/tree.c @@ -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 diff --git a/gcc/tree.h b/gcc/tree.h index 4c803f4..a776b89 100644 --- a/gcc/tree.h +++ b/gcc/tree.h @@ -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) -- cgit v1.1