Fortran: Various CLASS + assumed-rank fixed [PR102541]

Starting point was PR102541, were a previous patch caused an invalid
e->ref access for class. When testing, it turned out that for
CLASS to CLASS the code was never executed - additionally, issues
appeared for optional and a bogus error for -fcheck=all. In particular:

There were a bunch of issues related to optional CLASS, can have the
'attr.dummy' set in CLASS_DATA (sym) - but sometimes also in 'sym'!?!
Additionally, gfc_variable_attr could return pointer = 1 for nonpointers
when the expr is no longer "var" but "var%_data".

	PR fortran/102541

gcc/fortran/ChangeLog:

	* check.c (gfc_check_present): Handle optional CLASS.
	* interface.c (gfc_compare_actual_formal): Likewise.
	* trans-array.c (gfc_trans_g77_array): Likewise.
	* trans-decl.c (gfc_build_dummy_array_decl): Likewise.
	* trans-types.c (gfc_sym_type): Likewise.
	* primary.c (gfc_variable_attr): Fixes for dummy and
	pointer when 'class%_data' is passed.
	* trans-expr.c (set_dtype_for_unallocated, gfc_conv_procedure_call):
	For assumed-rank dummy, fix setting rank for dealloc/notassoc actual
	and setting ubound to -1 for assumed-size actuals.

gcc/testsuite/ChangeLog:

	* gfortran.dg/assumed_rank_24.f90: New test.

1 files changed, 13 insertions, 4 deletions

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 56a78d6..d873264 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2627,7 +2627,7 @@ check_substring:
 symbol_attribute
 gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 {
-  int dimension, codimension, pointer, allocatable, target;
+  int dimension, codimension, pointer, allocatable, target, optional;
   symbol_attribute attr;
   gfc_ref *ref;
   gfc_symbol *sym;
@@ -2640,12 +2640,14 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
   sym = expr->symtree->n.sym;
   attr = sym->attr;
 
+  optional = attr.optional;
   if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
     {
       dimension = CLASS_DATA (sym)->attr.dimension;
       codimension = CLASS_DATA (sym)->attr.codimension;
       pointer = CLASS_DATA (sym)->attr.class_pointer;
       allocatable = CLASS_DATA (sym)->attr.allocatable;
+      optional |= CLASS_DATA (sym)->attr.optional;
     }
   else
     {
@@ -2667,6 +2669,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
     if (ref->type == REF_INQUIRY)
       {
 	has_inquiry_part = true;
+	optional = false;
 	break;
       }
 
@@ -2684,12 +2687,13 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 	  case AR_SECTION:
 	    allocatable = pointer = 0;
 	    dimension = 1;
+	    optional = false;
 	    break;
 
 	  case AR_ELEMENT:
 	    /* Handle coarrays.  */
 	    if (ref->u.ar.dimen > 0)
-	      allocatable = pointer = 0;
+	      allocatable = pointer = optional = false;
 	    break;
 
 	  case AR_UNKNOWN:
@@ -2702,6 +2706,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 	break;
 
       case REF_COMPONENT:
+	optional = false;
 	comp = ref->u.c.component;
 	attr = comp->attr;
 	if (ts != NULL && !has_inquiry_part)
@@ -2723,7 +2728,10 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 	else
 	  {
 	    codimension = comp->attr.codimension;
-	    pointer = comp->attr.pointer;
+	    if (expr->ts.type == BT_CLASS && strcmp (comp->name, "_data") == 0)
+	      pointer = comp->attr.class_pointer;
+	    else
+	      pointer = comp->attr.pointer;
 	    allocatable = comp->attr.allocatable;
 	  }
 	if (pointer || attr.proc_pointer)
@@ -2733,7 +2741,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 
       case REF_INQUIRY:
       case REF_SUBSTRING:
-	allocatable = pointer = 0;
+	allocatable = pointer = optional = false;
 	break;
       }
 
@@ -2743,6 +2751,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
   attr.allocatable = allocatable;
   attr.target = target;
   attr.save = sym->attr.save;
+  attr.optional = optional;
 
   return attr;
 }