diff options
| author | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-07-02 19:53:37 +0000 |
|---|---|---|
| committer | janus <janus@138bc75d-0d04-0410-961f-82ee72b054a4> | 2008-07-02 19:53:37 +0000 |
| commit | cad0ddcfd966a705b9d1eeaa77d5e73d20939068 (patch) | |
| tree | 22cdfa5a0f9753aaa861e0696994a9d143ec1e49 /gcc/fortran/decl.c | |
| parent | 35c0d62d8355ad4715f632e777a4259d223dc023 (diff) | |
| download | gcc-cad0ddcfd966a705b9d1eeaa77d5e73d20939068.tar.gz | |
2008-07-02 Janus Weil <janus@gcc.gnu.org>
Tobias Burnus <burnus@net-b.de>
Paul Thomas <pault@gcc.gnu.org>
PR fortran/32580
* gfortran.h (struct gfc_symbol): New member "proc_pointer".
* check.c (gfc_check_associated,gfc_check_null): Implement
procedure pointers.
* decl.c (match_procedure_decl): Ditto.
* expr.c (gfc_check_pointer_assign,gfc_check_assign_symbol): Ditto.
* interface.c (compare_actual_formal): Ditto.
* match.h: Ditto.
* match.c (gfc_match_pointer_assignment): Ditto.
* parse.c (parse_interface): Ditto.
* primary.c (gfc_match_rvalue,match_variable): Ditto.
* resolve.c (resolve_fl_procedure): Ditto.
* symbol.c (check_conflict,gfc_add_external,gfc_add_pointer,
gfc_copy_attr,gen_fptr_param,build_formal_args): Ditto.
* trans-decl.c (get_proc_pointer_decl,gfc_get_extern_function_decl,
create_function_arglist): Ditto.
* trans-expr.c (gfc_conv_variable,gfc_conv_function_val,
gfc_conv_function_call,gfc_trans_pointer_assignment): Ditto.
2008-07-02 Janus Weil <janus@gcc.gnu.org>
Tobias Burnus <burnus@net-b.de>
PR fortran/32580
* gfortran.dg/c_f_pointer_tests_3.f90: Updated.
* gfortran.dg/proc_decl_1.f90: Updated.
* gfortran.dg/proc_ptr_1.f90: New.
* gfortran.dg/proc_ptr_2.f90: New.
* gfortran.dg/proc_ptr_3.f90: New.
* gfortran.dg/proc_ptr_4.f90: New.
* gfortran.dg/proc_ptr_5.f90: New.
* gfortran.dg/proc_ptr_6.f90: New.
* gfortran.dg/proc_ptr_7.f90: New.
* gfortran.dg/proc_ptr_8.f90: New.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@137386 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 42 |
1 files changed, 41 insertions, 1 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 869ece6c3f6..d23a32946ef 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4065,6 +4065,7 @@ match_procedure_decl (void) locus old_loc, entry_loc; gfc_symbol *sym, *proc_if = NULL; int num; + gfc_expr *initializer = NULL; old_loc = entry_loc = gfc_current_locus; @@ -4183,7 +4184,7 @@ got_ts: return MATCH_ERROR; } - if (!sym->attr.pointer && gfc_add_external (&sym->attr, NULL) == FAILURE) + if (gfc_add_external (&sym->attr, NULL) == FAILURE) return MATCH_ERROR; if (gfc_add_proc (&sym->attr, sym->name, NULL) == FAILURE) return MATCH_ERROR; @@ -4203,6 +4204,40 @@ got_ts: sym->attr.function = sym->ts.interface->attr.function; } + if (gfc_match (" =>") == MATCH_YES) + { + if (!current_attr.pointer) + { + gfc_error ("Initialization at %C isn't for a pointer variable"); + m = MATCH_ERROR; + goto cleanup; + } + + m = gfc_match_null (&initializer); + if (m == MATCH_NO) + { + gfc_error ("Pointer initialization requires a NULL() at %C"); + m = MATCH_ERROR; + } + + if (gfc_pure (NULL)) + { + gfc_error ("Initialization of pointer at %C is not allowed in " + "a PURE procedure"); + m = MATCH_ERROR; + } + + if (m != MATCH_YES) + goto cleanup; + + if (add_init_expr_to_sym (sym->name, &initializer, &gfc_current_locus) + != SUCCESS) + goto cleanup; + + } + + gfc_set_sym_referenced (sym); + if (gfc_match_eos () == MATCH_YES) return MATCH_YES; if (gfc_match_char (',') != MATCH_YES) @@ -4212,6 +4247,11 @@ got_ts: syntax: gfc_error ("Syntax error in PROCEDURE statement at %C"); return MATCH_ERROR; + +cleanup: + /* Free stuff up and return. */ + gfc_free_expr (initializer); + return m; } |