http://gcc.gnu.org/bugzilla/show_bug.cgi?id=55763
--- Comment #16 from Tobias Burnus <burnus at gcc dot gnu.org> 2013-01-03 23:51:11 UTC --- (In reply to comment #12) The patch has been submitted: http://gcc.gnu.org/ml/fortran/2013-01/msg00017.html (In reply to comment #13) > C512 (R506) The function-reference shall be a reference to the intrinsic > function NULL with no arguments. The patch has been submitted: http://gcc.gnu.org/ml/fortran/2013-01/msg00020.html > The following valid code gives an ICE: > class(*), pointer :: ptr2 => x Patch for the checking part below. TODO: Fixing the ICE for both CLASS(t) and CLASS(*). --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3765 +3765,4 @@ gfc_check_assign_symbol (gfc_symbol *sym, - if (sym->attr.pointer && rvalue->expr_type != EXPR_NULL) + if ((sym->attr.pointer + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA (sym)->attr.class_pointer)) + && rvalue->expr_type != EXPR_NULL) @@ -3772,2 +3775,2 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr - gfc_error ("Pointer initialization target at %C " - "must not be ALLOCATABLE "); + gfc_error ("Pointer initialization target at %L " + "must not be ALLOCATABLE", &rvalue->where); @@ -3778,2 +3781,2 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr - gfc_error ("Pointer initialization target at %C " - "must have the TARGET attribute"); + gfc_error ("Pointer initialization target at %L " + "must have the TARGET attribute", &rvalue->where); @@ -3781,0 +3785,9 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr + + if (!attr.save && rvalue->expr_type == EXPR_VARIABLE + && rvalue->symtree->n.sym->ns->proc_name + && rvalue->symtree->n.sym->ns->proc_name->attr.is_main_program) + { + rvalue->symtree->n.sym->ns->proc_name->attr.save = SAVE_IMPLICIT; + attr.save = SAVE_IMPLICIT; + } + @@ -3784,2 +3796,2 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr - gfc_error ("Pointer initialization target at %C " - "must have the SAVE attribute"); + gfc_error ("Pointer initialization target at %L " + "must have the SAVE attribute", &rvalue->where);
