aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-decl.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/trans-decl.c')
-rw-r--r--gcc/fortran/trans-decl.c58
1 files changed, 32 insertions, 26 deletions
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 588f55a..88f9c56 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -327,7 +327,7 @@ gfc_sym_mangled_identifier (gfc_symbol * sym)
binding label (mainly those that are bind(c)). */
if (sym->attr.is_bind_c == 1 && sym->binding_label)
return get_identifier (sym->binding_label);
-
+
if (sym->module == NULL)
return gfc_sym_identifier (sym);
else
@@ -433,14 +433,14 @@ gfc_finish_cray_pointee (tree decl, gfc_symbol *sym)
tree value;
/* Parameters need to be dereferenced. */
- if (sym->cp_pointer->attr.dummy)
+ if (sym->cp_pointer->attr.dummy)
ptr_decl = build_fold_indirect_ref_loc (input_location,
ptr_decl);
/* Check to see if we're dealing with a variable-sized array. */
if (sym->attr.dimension
- && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
- {
+ && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
+ {
/* These decls will be dereferenced later, so we don't dereference
them here. */
value = convert (TREE_TYPE (decl), ptr_decl);
@@ -483,7 +483,7 @@ gfc_finish_decl (tree decl)
/* We should know the storage size. */
gcc_assert (DECL_SIZE (decl) != NULL_TREE
- || (TREE_STATIC (decl)
+ || (TREE_STATIC (decl)
? (!DECL_INITIAL (decl) || !DECL_CONTEXT (decl))
: DECL_EXTERNAL (decl)));
@@ -550,7 +550,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
TREE_PUBLIC(decl) = 1;
DECL_COMMON(decl) = 1;
}
-
+
/* If a variable is USE associated, it's always external. */
if (sym->attr.use_assoc)
{
@@ -592,7 +592,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
TREE_SIDE_EFFECTS (decl) = 1;
new_type = build_qualified_type (TREE_TYPE (decl), TYPE_QUAL_VOLATILE);
TREE_TYPE (decl) = new_type;
- }
+ }
/* Keep variables larger than max-stack-var-size off stack. */
if (!sym->ns->proc_name->attr.recursive
@@ -948,7 +948,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
/* Do we know the element size? */
known_size = sym->ts.type != BT_CHARACTER
|| INTEGER_CST_P (sym->ts.u.cl->backend_decl);
-
+
if (known_size && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type)))
{
/* For descriptorless arrays with known element size the actual
@@ -1558,7 +1558,7 @@ get_proc_pointer_decl (gfc_symbol *sym)
if (sym->attr.use_assoc)
DECL_IGNORED_P (decl) = 1;
}
-
+
if ((sym->ns->proc_name
&& sym->ns->proc_name->backend_decl == current_function_decl)
|| sym->attr.contained)
@@ -1984,7 +1984,7 @@ create_function_arglist (gfc_symbol * sym)
type = TREE_VALUE (typelist);
parm = build_decl (input_location,
PARM_DECL, get_identifier ("__entry"), type);
-
+
DECL_CONTEXT (parm) = fndecl;
DECL_ARG_TYPE (parm) = type;
TREE_READONLY (parm) = 1;
@@ -2106,7 +2106,7 @@ create_function_arglist (gfc_symbol * sym)
gfc_finish_decl (length);
/* Remember the passed value. */
- if (f->sym->ts.u.cl->passed_length != NULL)
+ if (!f->sym->ts.u.cl || f->sym->ts.u.cl->passed_length)
{
/* This can happen if the same type is used for multiple
arguments. We need to copy cl as otherwise
@@ -2215,7 +2215,7 @@ create_function_arglist (gfc_symbol * sym)
gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE);
GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) = token;
}
-
+
DECL_CONTEXT (token) = fndecl;
DECL_ARTIFICIAL (token) = 1;
DECL_ARG_TYPE (token) = TREE_VALUE (typelist);
@@ -2314,7 +2314,7 @@ build_entry_thunks (gfc_namespace * ns, bool global)
vec<tree, va_gc> *string_args = NULL;
thunk_sym = el->sym;
-
+
build_function_decl (thunk_sym, global);
create_function_arglist (thunk_sym);
@@ -2411,7 +2411,7 @@ build_entry_thunks (gfc_namespace * ns, bool global)
tmp = fold_build3_loc (input_location, COMPONENT_REF,
TREE_TYPE (field), union_decl, field,
NULL_TREE);
- tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+ tmp = fold_build2_loc (input_location, MODIFY_EXPR,
TREE_TYPE (DECL_RESULT (current_function_decl)),
DECL_RESULT (current_function_decl), tmp);
tmp = build1_v (RETURN_EXPR, tmp);
@@ -2985,7 +2985,7 @@ gfc_build_intrinsic_function_decls (void)
gfc_int4_type_node);
TREE_READONLY (gfor_fndecl_math_ishftc4) = 1;
TREE_NOTHROW (gfor_fndecl_math_ishftc4) = 1;
-
+
gfor_fndecl_math_ishftc8 = gfc_build_library_function_decl (
get_identifier (PREFIX("ishftc8")),
gfc_int8_type_node, 3, gfc_int8_type_node, gfc_int4_type_node,
@@ -3121,7 +3121,7 @@ gfc_build_builtin_function_decls (void)
void_type_node, -2, pchar_type_node, pchar_type_node);
/* The runtime_error_at function does not return. */
TREE_THIS_VOLATILE (gfor_fndecl_runtime_error_at) = 1;
-
+
gfor_fndecl_runtime_warning_at = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("runtime_warning_at")), ".RR",
void_type_node, -2, pchar_type_node, pchar_type_node);
@@ -3816,7 +3816,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->ts.type == BT_CLASS)
{
/* Initialize _vptr to declared type. */
- gfc_symbol *vtab = gfc_find_derived_vtab (sym->ts.u.derived);
+ gfc_symbol *vtab;
tree rhs;
gfc_save_backend_locus (&loc);
@@ -3827,8 +3827,14 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
se.want_pointer = 1;
gfc_conv_expr (&se, e);
gfc_free_expr (e);
- rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
- gfc_get_symbol_decl (vtab));
+ if (UNLIMITED_POLY (sym))
+ rhs = build_int_cst (TREE_TYPE (se.expr), 0);
+ else
+ {
+ vtab = gfc_find_derived_vtab (sym->ts.u.derived);
+ rhs = gfc_build_addr_expr (TREE_TYPE (se.expr),
+ gfc_get_symbol_decl (vtab));
+ }
gfc_add_modify (&init, se.expr, rhs);
gfc_restore_backend_locus (&loc);
}
@@ -3894,7 +3900,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock),
NULL_TREE);
}
- else
+ else if (!(UNLIMITED_POLY(sym)))
gcc_unreachable ();
}
@@ -4347,7 +4353,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
tree tmp, size, decl, token;
if (sym->attr.dummy || sym->attr.allocatable || !sym->attr.codimension
- || sym->attr.use_assoc || !sym->attr.referenced)
+ || sym->attr.use_assoc || !sym->attr.referenced)
return;
decl = sym->backend_decl;
@@ -4360,7 +4366,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
size = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (decl)));
- /* Ensure that we do not have size=0 for zero-sized arrays. */
+ /* Ensure that we do not have size=0 for zero-sized arrays. */
size = fold_build2_loc (input_location, MAX_EXPR, size_type_node,
fold_convert (size_type_node, size),
build_int_cst (size_type_node, 1));
@@ -4382,7 +4388,7 @@ generate_coarray_sym_init (gfc_symbol *sym)
token, null_pointer_node, /* token, stat. */
null_pointer_node, /* errgmsg, errmsg_len. */
build_int_cst (integer_type_node, 0));
-
+
gfc_add_modify (&caf_init_block, decl, fold_convert (TREE_TYPE (decl), tmp));
@@ -4724,7 +4730,7 @@ generate_local_decl (gfc_symbol * sym)
{
if (gfc_option.warn_unused_dummy_argument)
gfc_warning ("Unused dummy argument '%s' at %L", sym->name,
- &sym->declared_at);
+ &sym->declared_at);
}
/* Silence bogus "unused parameter" warnings from the
@@ -5151,9 +5157,9 @@ create_main_function (tree fndecl)
/* Coarray: Call _gfortran_caf_finalize(void). */
if (gfc_option.coarray == GFC_FCOARRAY_LIB)
- {
+ {
/* Per F2008, 8.5.1 END of the main program implies a
- SYNC MEMORY. */
+ SYNC MEMORY. */
tmp = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
tmp = build_call_expr_loc (input_location, tmp, 0);
gfc_add_expr_to_block (&body, tmp);
generated by cgit v1.1 at 2024-08-23 00:43:52 +0000