Hi,
this patch removes the check for TREE_CODE of pointer types when computing
canonical types. It also adds a testcase for fortran C_PTR type that should be
compatible with all C pointers. Can someone familiar with Fortran double check
that the testcase is indeed defined by the standard?
I needed to hack get_alias_set because TYPE_CANONICAL of ptr_type_node is no
longer ptr_type_node. This is ugly, but I plan to drop that code path anyway.
(the idea is to get type merging correct and then enable the non-LTO scheme
of get_alias_set for LTO, too).
Bootstrapped/regtested ppc64-linux, OK?
Honza
* alias.c (get_alias_set): Be ready for TYPE_CANONICAL
of ptr_type_node to not be ptr_to_node.
* tree.c (gimple_types_compatible_p): Do not match TREE_CODE of
TREE_TYPE of pointers
* lto.c (hash_canonical_type): Do not hash TREE_CODE of TREE_TYPE of
pointers.
* gfortran.dg/lto/bind_c-1_0.f90: New testcase.
* gfortran.dg/lto/bind_c-1_1.c: New testcase.
Index: alias.c
===================================================================
--- alias.c (revision 223891)
+++ alias.c (working copy)
@@ -1076,8 +1076,9 @@
}
/* In LTO the rules above needs to be part of canonical type machinery.
For now just punt. */
- else if (POINTER_TYPE_P (t) && t != ptr_type_node && in_lto_p)
- set = get_alias_set (ptr_type_node);
+ else if (POINTER_TYPE_P (t)
+ && t != TYPE_CANONICAL (ptr_type_node) && in_lto_p)
+ set = get_alias_set (TYPE_CANONICAL (ptr_type_node));
/* Otherwise make a new alias set for this type. */
else
Index: lto/lto.c
===================================================================
--- lto/lto.c (revision 223891)
+++ lto/lto.c (working copy)
@@ -342,12 +342,12 @@
if (TREE_CODE (type) == COMPLEX_TYPE)
hstate.add_int (TYPE_UNSIGNED (type));
- /* For pointer and reference types, fold in information about the type
- pointed to but do not recurse to the pointed-to type. */
+ /* 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. */
if (POINTER_TYPE_P (type))
{
hstate.add_int (TYPE_ADDR_SPACE (TREE_TYPE (type)));
- hstate.add_int (TREE_CODE (TREE_TYPE (type)));
}
/* For integer types hash only the string flag. */
Index: testsuite/gfortran.dg/lto/bind_c-1_0.f90
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-1_0.f90 (revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-1_0.f90 (working copy)
@@ -0,0 +1,21 @@
+! { dg-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
+ type(c_ptr) :: ptr
+ type(c_ptr) :: ptrb
+ end type MYFTYPE_1
+
+ type(myftype_1), bind(c, name="myVar") :: myVar
+
+contains
+ subroutine types_test() bind(c)
+ myVar%ptr = myVar%ptrb
+ end subroutine types_test
+end module lto_type_merge_test
+
Index: testsuite/gfortran.dg/lto/bind_c-1_1.c
===================================================================
--- testsuite/gfortran.dg/lto/bind_c-1_1.c (revision 0)
+++ testsuite/gfortran.dg/lto/bind_c-1_1.c (working copy)
@@ -0,0 +1,36 @@
+#include <stdlib.h>
+/* interopse with myftype_1 */
+typedef struct {
+ float *ptr;
+ int *ptr2;
+} 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 *cptr;
+ asm("":"=r"(cptr):"0"(&myVar));
+ cptr->ptr = (float *)(size_t) (void *)1;
+ cptr->ptr2 = (int *)(size_t) (void *)2;
+
+ types_test();
+
+ if(cptr->ptr != (float *)(size_t) (void *)2)
+ abort();
+ if(cptr->ptr2 != (int *)(size_t) (void *)2)
+ abort();
+ myVar.ptr2 = (int *)(size_t) (void *)3;
+ types_test();
+
+ if(myVar.ptr != (float *)(size_t) (void *)3)
+ abort();
+ if(myVar.ptr2 != (int *)(size_t) (void *)3)
+ abort();
+ return 0;
+}
+
Index: tree.c
===================================================================
--- tree.c (revision 223891)
+++ tree.c (working copy)
@@ -12909,18 +12910,14 @@
&& TYPE_STRING_FLAG (t1) != TYPE_STRING_FLAG (t2))
return false;
- /* For canonical type comparisons we do not want to build SCCs
- so we cannot compare pointed-to types. But we can, for now,
- require the same pointed-to type kind and match what
- useless_type_conversion_p would do. */
+ /* 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. */
if (POINTER_TYPE_P (t1))
{
if (TYPE_ADDR_SPACE (TREE_TYPE (t1))
!= TYPE_ADDR_SPACE (TREE_TYPE (t2)))
return false;
-
- if (TREE_CODE (TREE_TYPE (t1)) != TREE_CODE (TREE_TYPE (t2)))
- return false;
}
/* Tail-recurse to components. */
Index: tree.h
===================================================================
--- tree.h (revision 223891)
+++ tree.h (working copy)
@@ -4598,7 +4598,28 @@
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);
+/* 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)
+{
+ /* By C standard, each enumerated type shall be compatible with char,
+ a signed integer, or an unsigned integer. The choice of type is
+ implementation defined (in our case it depends on -fshort-enum).
+ For this reason we make no distinction between ENUMERAL_TYPE and INTEGER
+ type and compare only by their signedness and precision. */
+ if (code == ENUMERAL_TYPE)
+ return INTEGER_TYPE;
+ /* To allow inter-operability between languages having references and
+ C, we consider reference types and pointers alike. Note that this is
+ not strictly necessary for C-Fortran 2008 interoperability because
+ Fortran define C_PTR type that needs to be compatible with C pointers
+ and we handle this one as ptr_type_node. */
+ if (code == REFERENCE_TYPE)
+ return POINTER_TYPE;
+ return code;
+}
+
#define tree_map_eq tree_map_base_eq
extern unsigned int tree_map_hash (const void *);
#define tree_map_marked_p tree_map_base_marked_p
