diff options
Diffstat (limited to 'gcc/fortran/trans-decl.c')
-rw-r--r-- | gcc/fortran/trans-decl.c | 58 |
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); |