/* Backend support for Fortran 95 basic types and derived types.
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
and Steven Bosscher <s.bosscher@student.tudelft.nl>
int gfc_character_storage_size;
-/* Validate that the f90_type of the given gfc_typespec is valid for
- the type it represents. The f90_type represents the Fortran types
- this C kind can be used with. For example, c_int has a f90_type of
- BT_INTEGER and c_float has a f90_type of BT_REAL. Returns FAILURE
- if a mismatch occurs between ts->f90_type and ts->type; SUCCESS if
- they match. */
-
-gfc_try
-gfc_validate_c_kind (gfc_typespec *ts)
-{
- return ((ts->type == ts->f90_type) ? SUCCESS : FAILURE);
-}
-
-
gfc_try
gfc_check_any_c_kind (gfc_typespec *ts)
{
mpz_clear (stride);
mpz_clear (delta);
- /* In debug info represent packed arrays as multi-dimensional
- if they have rank > 1 and with proper bounds, instead of flat
- arrays. */
- if (known_offset && write_symbols != NO_DEBUG)
+ /* Represent packed arrays as multi-dimensional if they have rank >
+ 1 and with proper bounds, instead of flat arrays. This makes for
+ better debug info. */
+ if (known_offset)
{
tree gtype = etype, rtype, type_decl;
tree type;
int byref;
+ /* Procedure Pointers inside COMMON blocks or as function result. */
+ if (sym->attr.proc_pointer && (sym->attr.in_common || sym->attr.result))
+ {
+ /* Unset proc_pointer as gfc_get_function_type calls gfc_sym_type. */
+ sym->attr.proc_pointer = 0;
+ type = build_pointer_type (gfc_get_function_type (sym));
+ sym->attr.proc_pointer = 1;
+ return type;
+ }
+
if (sym->attr.flavor == FL_PROCEDURE && !sym->attr.function)
return void_type_node;
gfc_finish_type (typenode);
gfc_set_decl_location (TYPE_STUB_DECL (typenode), &derived->declared_at);
- if (derived->module && derived->ns->proc_name->attr.flavor == FL_MODULE)
+ if (derived->module && derived->ns->proc_name
+ && derived->ns->proc_name->attr.flavor == FL_MODULE)
{
if (derived->ns->proc_name->backend_decl
&& TREE_CODE (derived->ns->proc_name->backend_decl)
type = gfc_typenode_for_spec (&sym->ts);
sym->ts.kind = gfc_default_real_kind;
}
+ else if (sym->result && sym->result->attr.proc_pointer)
+ /* Procedure pointer return values. */
+ type = gfc_sym_type (sym->result);
else
type = gfc_sym_type (sym);
else
info->base_decl = base_decl = build_decl (VAR_DECL, NULL_TREE, ptype);
- elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype));
+ if (GFC_TYPE_ARRAY_SPAN (type))
+ elem_size = GFC_TYPE_ARRAY_SPAN (type);
+ else
+ elem_size = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (etype));
field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type));
data_off = byte_position (field);
field = TREE_CHAIN (field);