diff options
author | Janus Weil <janus@gcc.gnu.org> | 2009-05-06 23:17:16 +0200 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2009-05-06 23:17:16 +0200 |
commit | 713485cc676555c25f30c477f8b147bf98061c52 (patch) | |
tree | 0bf13a907194f732406ab43f087a5e03de7889c7 /gcc/fortran/symbol.c | |
parent | 641cac0b195f01af249f6e96207b7b27c3094557 (diff) | |
download | gcc-713485cc676555c25f30c477f8b147bf98061c52.zip gcc-713485cc676555c25f30c477f8b147bf98061c52.tar.gz gcc-713485cc676555c25f30c477f8b147bf98061c52.tar.bz2 |
re PR fortran/39630 ([F03] Procedure Pointer Components)
2009-05-06 Janus Weil <janus@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/39630
* decl.c (match_procedure_interface): New function to match the
interface for a PROCEDURE statement.
(match_procedure_decl): Call match_procedure_interface.
(match_ppc_decl): New function to match the declaration of a
procedure pointer component.
(gfc_match_procedure): Call match_ppc_decl.
(match_binding_attributes): Add new argument 'ppc' and handle the
POINTER attribute for procedure pointer components.
(match_procedure_in_type,gfc_match_generic): Added new argument to
match_binding_attributes.
* dump-parse-tree.c (show_expr,show_components,show_code_node): Handle
procedure pointer components.
* expr.c (free_expr0,gfc_copy_expr,gfc_simplify_expr): Handle EXPR_PPC.
(gfc_check_pointer_assign): Handle procedure pointer components, but no
full checking yet.
(is_proc_ptr_comp): New function to determine if an expression is a
procedure pointer component.
* gfortran.h (expr_t): Add EXPR_PPC.
(symbol_attribute): Add new member 'proc_pointer_comp'.
(gfc_component): Add new member 'formal'.
(gfc_exec_op): Add EXEC_CALL_PPC.
(gfc_get_default_type): Changed first argument.
(is_proc_ptr_comp): Add prototype.
(gfc_match_varspec): Add new argument.
* interface.c (compare_actual_formal): Handle procedure pointer
components.
* match.c (gfc_match_pointer_assignment,match_typebound_call): Handle
procedure pointer components.
* module.c (mio_expr): Handle EXPR_PPC.
* parse.c (parse_derived): Handle procedure pointer components.
* primary.c (gfc_match_varspec): Add new argument 'ppc_arg' and handle
procedure pointer components.
(gfc_variable_attr): Handle procedure pointer components.
(gfc_match_rvalue): Added new argument to gfc_match_varspec and changed
first argument of gfc_get_default_type.
(match_variable): Added new argument to gfc_match_varspec.
* resolve.c (resolve_entries,set_type,resolve_fl_parameter): Changed
first argument of gfc_get_default_type.
(resolve_structure_cons,resolve_actual_arglist): Handle procedure
pointer components.
(resolve_ppc_call): New function to resolve a call to a procedure
pointer component (subroutine).
(resolve_expr_ppc): New function to resolve a call to a procedure
pointer component (function).
(gfc_resolve_expr): Handle EXPR_PPC.
(resolve_code): Handle EXEC_CALL_PPC.
(resolve_fl_derived): Copy the interface for a procedure pointer
component.
(resolve_symbol): Fix overlong line.
* st.c (gfc_free_statement): Handle EXEC_CALL_PPC.
* symbol.c (gfc_get_default_type): Changed first argument.
(gfc_set_default_type): Changed first argument of gfc_get_default_type.
(gfc_add_component): Initialize ts.type to BT_UNKNOWN.
* trans.h (gfc_conv_function_call): Renamed.
* trans.c (gfc_trans_code): Handle EXEC_CALL_PPC.
* trans-expr.c (gfc_conv_component_ref): Ditto.
(gfc_conv_function_val): Rename to 'conv_function_val', add new
argument 'expr' and handle procedure pointer components.
(gfc_conv_operator_assign): Renamed gfc_conv_function_val.
(gfc_apply_interface_mapping_to_expr): Handle EXPR_PPC.
(gfc_conv_function_call): Rename to 'gfc_conv_procedure_call', add new
argument 'expr' and handle procedure pointer components.
(gfc_get_proc_ptr_comp): New function to get the backend decl for a
procedure pointer component.
(gfc_conv_function_expr): Renamed gfc_conv_function_call.
(gfc_conv_structure): Handle procedure pointer components.
* trans-intrinsic.c (gfc_conv_intrinsic_funcall,
conv_generic_with_optional_char_arg): Renamed gfc_conv_function_call.
* trans-stmt.h (gfc_get_proc_ptr_comp): Add prototype.
* trans-stmt.c (gfc_trans_call): Renamed gfc_conv_function_call.
* trans-types.h (gfc_get_ppc_type): Add prototype.
* trans-types.c (gfc_get_ppc_type): New function to build a tree node
for a procedure pointer component.
(gfc_get_derived_type): Handle procedure pointer components.
2009-05-06 Janus Weil <janus@gcc.gnu.org>
PR fortran/39630
* gfortran.dg/proc_decl_1.f90: Modified.
* gfortran.dg/proc_ptr_comp_1.f90: New.
* gfortran.dg/proc_ptr_comp_2.f90: New.
* gfortran.dg/proc_ptr_comp_3.f90: New.
* gfortran.dg/proc_ptr_comp_4.f90: New.
* gfortran.dg/proc_ptr_comp_5.f90: New.
* gfortran.dg/proc_ptr_comp_6.f90: New.
Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>
From-SVN: r147206
Diffstat (limited to 'gcc/fortran/symbol.c')
-rw-r--r-- | gcc/fortran/symbol.c | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index a82e675..2160afa 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -219,11 +219,11 @@ gfc_merge_new_implicit (gfc_typespec *ts) /* Given a symbol, return a pointer to the typespec for its default type. */ gfc_typespec * -gfc_get_default_type (gfc_symbol *sym, gfc_namespace *ns) +gfc_get_default_type (const char *name, gfc_namespace *ns) { char letter; - letter = sym->name[0]; + letter = name[0]; if (gfc_option.flag_allow_leading_underscore && letter == '_') gfc_internal_error ("Option -fallow-leading-underscore is for use only by " @@ -231,7 +231,7 @@ gfc_get_default_type (gfc_symbol *sym, gfc_namespace *ns) "implicitly typed variables"); if (letter < 'a' || letter > 'z') - gfc_internal_error ("gfc_get_default_type(): Bad symbol '%s'",sym->name); + gfc_internal_error ("gfc_get_default_type(): Bad symbol '%s'", name); if (ns == NULL) ns = gfc_current_ns; @@ -252,7 +252,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) if (sym->ts.type != BT_UNKNOWN) gfc_internal_error ("gfc_set_default_type(): symbol already has a type"); - ts = gfc_get_default_type (sym, ns); + ts = gfc_get_default_type (sym->name, ns); if (ts->type == BT_UNKNOWN) { @@ -1779,6 +1779,7 @@ gfc_add_component (gfc_symbol *sym, const char *name, p->name = gfc_get_string (name); p->loc = gfc_current_locus; + p->ts.type = BT_UNKNOWN; *component = p; return SUCCESS; @@ -4494,3 +4495,4 @@ gfc_get_tbp_symtree (gfc_symtree **root, const char *name) return result; } + |