diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2012-07-30 21:55:41 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2012-07-30 21:55:41 +0200 |
| commit | 2dda89a89839310c852c5c1c77de7db59df5b113 (patch) | |
| tree | 967f294cebb894be86bd2873e725cb5adf332b9b /gcc/fortran/primary.c | |
| parent | caf624554c8dd1bc1bf582a9ff38dec033fba5b3 (diff) | |
| download | gcc-2dda89a89839310c852c5c1c77de7db59df5b113.zip gcc-2dda89a89839310c852c5c1c77de7db59df5b113.tar.gz gcc-2dda89a89839310c852c5c1c77de7db59df5b113.tar.bz2 | |
re PR fortran/51081 ([F03] Proc-pointer assignment: Rejects valid internal proc)
2012-07-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/51081
* gfortran.h (gfc_resolve_intrinsic): Add prototype.
* expr.c (gfc_check_pointer_assign): Set INTRINSIC attribute if needed.
Check for invalid intrinsics.
* primary.c (gfc_match_rvalue): Check for intrinsics came too early.
Set procedure flavor if appropriate.
* resolve.c (resolve_intrinsic): Renamed to gfc_resolve_intrinsic.
(resolve_procedure_interface,resolve_procedure_expression,
resolve_function,resolve_fl_derived0,resolve_symbol): Ditto.
2012-07-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/51081
* gfortran.dg/proc_ptr_37.f90: New.
From-SVN: r189985
Diffstat (limited to 'gcc/fortran/primary.c')
| -rw-r--r-- | gcc/fortran/primary.c | 11 |
1 files changed, 8 insertions, 3 deletions
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c index e2c3f99..29d2789 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.c @@ -2843,13 +2843,18 @@ gfc_match_rvalue (gfc_expr **result) /* Parse functions returning a procptr. */ goto function0; - if (gfc_is_intrinsic (sym, 0, gfc_current_locus) - || gfc_is_intrinsic (sym, 1, gfc_current_locus)) - sym->attr.intrinsic = 1; e = gfc_get_expr (); e->expr_type = EXPR_VARIABLE; e->symtree = symtree; m = gfc_match_varspec (e, 0, false, true); + if (!e->ref && sym->attr.flavor == FL_UNKNOWN + && sym->ts.type == BT_UNKNOWN + && gfc_add_flavor (&sym->attr, FL_PROCEDURE, + sym->name, NULL) == FAILURE) + { + m = MATCH_ERROR; + break; + } break; } |