[Bug fortran/49397] ICE with proc pointer assignment

["burnus at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=49397

--- Comment #1 from Tobias Burnus <burnus at gcc dot gnu.org> 2011-06-14 08:27:44 UTC ---
More information:

* (2): Case "g" works: If the "print *, g()" as the "p => g" is in the same
  scoping unit, there is no error or ICE.
* (1) If the "print *, f" is in the host of "p => f", there is an ICE.
* (example (3) works - thus not shown, cf. IR 11-198).

My impression is that the error message is OK, but that the assert is wrong. If
you change the assert, please make sure it works also with additional nesting
due to BLOCK (cf. PR 49400).

The failing assert is:

1774   /* Allow only one nesting level.  Allow public declarations.  */
1775   gcc_assert (current_function_decl == NULL_TREE
1776               || DECL_FILE_SCOPE_P (current_function_decl)
1777               || (TREE_CODE (DECL_CONTEXT (current_function_decl))
1778                   == NAMESPACE_DECL));


The check leading to the error message is generated in
gfc_check_pointer_assign:

3349       attr = gfc_expr_attr (rvalue);
3350       if (!((rvalue->expr_type == EXPR_NULL)
3351             || (rvalue->expr_type == EXPR_FUNCTION && attr.proc_pointer)
3352             || (rvalue->expr_type == EXPR_VARIABLE && attr.proc_pointer)
3353             || (rvalue->expr_type == EXPR_VARIABLE
3354                 && attr.flavor == FL_PROCEDURE)))
3355         {
3356           gfc_error ("Invalid procedure pointer assignment at %L",
3357                      &rvalue->where);
3358           return FAILURE;
3359         }