[Bug fortran/55763] Issues with some simpler CLASS(*) programs

[burnus at gcc dot gnu.org]

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);