X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=gcc%2Ffortran%2Ftrans-types.c;h=4c0daf453829e3fc30e806735e1d7cb89c93e98d;hb=989adef3b44d84f7b46c259ba46911460de87c51;hp=18644779fc1bde3a24acea745612d1ff28172112;hpb=66a56860076243903465dadec8482f55d32144dc;p=pf3gnuchains%2Fgcc-fork.git diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 18644779fc1..4c0daf45382 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1,5 +1,6 @@ /* Backend support for Fortran 95 basic types and derived types. - Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 + Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, + 2010 Free Software Foundation, Inc. Contributed by Paul Brook and Steven Bosscher @@ -26,8 +27,7 @@ along with GCC; see the file COPYING3. If not see #include "system.h" #include "coretypes.h" #include "tree.h" -#include "langhooks.h" -#include "tm.h" +#include "langhooks.h" /* For iso-c-bindings.def. */ #include "target.h" #include "ggc.h" #include "toplev.h" @@ -37,7 +37,7 @@ along with GCC; see the file COPYING3. If not see #include "trans-const.h" #include "real.h" #include "flags.h" -#include "dwarf2out.h" +#include "dwarf2out.h" /* For struct array_descr_info. */ #if (GFC_MAX_DIMENSIONS < 10) @@ -53,8 +53,6 @@ along with GCC; see the file COPYING3. If not see /* array of structs so we don't have to worry about xmalloc or free */ CInteropKind_t c_interop_kinds_table[ISOCBINDING_NUMBER]; -static tree gfc_get_derived_type (gfc_symbol * derived); - tree gfc_array_index_type; tree gfc_array_range_type; tree gfc_character1_type_node; @@ -871,7 +869,7 @@ gfc_init_types (void) ppvoid_type_node = build_pointer_type (pvoid_type_node); pchar_type_node = build_pointer_type (gfc_character1_type_node); pfunc_type_node - = build_pointer_type (build_function_type (void_type_node, NULL_TREE)); + = build_pointer_type (build_function_type_list (void_type_node, NULL_TREE)); gfc_array_index_type = gfc_get_int_type (gfc_index_integer_kind); /* We cannot use gfc_index_zero_node in definition of gfc_array_range_type, @@ -1195,7 +1193,7 @@ gfc_is_nodesc_array (gfc_symbol * sym) if (sym->attr.result || sym->attr.function) return 0; - gcc_assert (sym->as->type == AS_EXPLICIT); + gcc_assert (sym->as->type == AS_EXPLICIT || sym->as->cp_was_assumed); return 1; } @@ -1223,8 +1221,8 @@ gfc_build_array_type (tree type, gfc_array_spec * as, if (as->type == AS_ASSUMED_SHAPE) akind = GFC_ARRAY_ASSUMED_SHAPE; - return gfc_get_array_type_bounds (type, as->rank, lbound, ubound, 0, akind, - restricted); + return gfc_get_array_type_bounds (type, as->rank, as->corank, lbound, + ubound, 0, akind, restricted); } /* Returns the struct descriptor_dimension type. */ @@ -1539,20 +1537,20 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed, /* Return or create the base type for an array descriptor. */ static tree -gfc_get_array_descriptor_base (int dimen, bool restricted) +gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted) { tree fat_type, fieldlist, decl, arraytype; - char name[16 + GFC_RANK_DIGITS + 1]; - int idx = 2 * (dimen - 1) + restricted; + char name[16 + 2*GFC_RANK_DIGITS + 1 + 1]; + int idx = 2 * (codimen + dimen - 1) + restricted; - gcc_assert (dimen >= 1 && dimen <= GFC_MAX_DIMENSIONS); + gcc_assert (dimen >= 1 && codimen + dimen <= GFC_MAX_DIMENSIONS); if (gfc_array_descriptor_base[idx]) return gfc_array_descriptor_base[idx]; /* Build the type node. */ fat_type = make_node (RECORD_TYPE); - sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen); + sprintf (name, "array_descriptor" GFC_RANK_PRINTF_FORMAT, dimen + codimen); TYPE_NAME (fat_type) = get_identifier (name); /* Add the data member as the first element of the descriptor. */ @@ -1584,7 +1582,7 @@ gfc_get_array_descriptor_base (int dimen, bool restricted) build_array_type (gfc_get_desc_dim_type (), build_range_type (gfc_array_index_type, gfc_index_zero_node, - gfc_rank_cst[dimen - 1])); + gfc_rank_cst[codimen + dimen - 1])); decl = build_decl (input_location, FIELD_DECL, get_identifier ("dim"), arraytype); @@ -1605,20 +1603,20 @@ gfc_get_array_descriptor_base (int dimen, bool restricted) /* Build an array (descriptor) type with given bounds. */ tree -gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, +gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, tree * ubound, int packed, enum gfc_array_kind akind, bool restricted) { - char name[8 + GFC_RANK_DIGITS + GFC_MAX_SYMBOL_LEN]; + char name[8 + 2*GFC_RANK_DIGITS + 1 + GFC_MAX_SYMBOL_LEN]; tree fat_type, base_type, arraytype, lower, upper, stride, tmp, rtype; const char *type_name; int n; - base_type = gfc_get_array_descriptor_base (dimen, restricted); + base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted); fat_type = build_distinct_type_copy (base_type); /* Make sure that nontarget and target array type have the same canonical type (and same stub decl for debug info). */ - base_type = gfc_get_array_descriptor_base (dimen, false); + base_type = gfc_get_array_descriptor_base (dimen, codimen, false); TYPE_CANONICAL (fat_type) = base_type; TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type); @@ -1629,7 +1627,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound, type_name = IDENTIFIER_POINTER (tmp); else type_name = "unknown"; - sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen, + sprintf (name, "array" GFC_RANK_PRINTF_FORMAT "_%.*s", dimen + codimen, GFC_MAX_SYMBOL_LEN, type_name); TYPE_NAME (fat_type) = get_identifier (name); @@ -1777,7 +1775,7 @@ gfc_sym_type (gfc_symbol * sym) byref = 0; restricted = !sym->attr.target && !sym->attr.pointer - && !sym->attr.proc_pointer; + && !sym->attr.proc_pointer && !sym->attr.cray_pointee; if (sym->attr.dimension) { if (gfc_is_nodesc_array (sym)) @@ -1794,6 +1792,9 @@ gfc_sym_type (gfc_symbol * sym) restricted); byref = 0; } + + if (sym->attr.cray_pointee) + GFC_POINTER_TYPE_P (type) = 1; } else { @@ -1809,7 +1810,7 @@ gfc_sym_type (gfc_symbol * sym) { if (sym->attr.allocatable || sym->attr.pointer) type = gfc_build_pointer_type (sym, type); - if (sym->attr.pointer) + if (sym->attr.pointer || sym->attr.cray_pointee) GFC_POINTER_TYPE_P (type) = 1; } @@ -1932,7 +1933,7 @@ gfc_get_ppc_type (gfc_component* c) else t = void_type_node; - return build_pointer_type (build_function_type (t, NULL_TREE)); + return build_pointer_type (build_function_type_list (t, NULL_TREE)); } @@ -1941,7 +1942,7 @@ gfc_get_ppc_type (gfc_component* c) at the same time. If an equal derived type has been built in a parent namespace, this is used. */ -static tree +tree gfc_get_derived_type (gfc_symbol * derived) { tree typenode = NULL, field = NULL, field_type = NULL, fieldlist = NULL;