[PATCH, Fortran, pr78672, ctp1, v1] Gfortran test suite failures with a sanitized compiler

[Andre Vehreschild <vehre at gmx dot de>]

Hi all, hi Dominique,

this is the "compile time part 1" (ctp1) patch to fix the issues reported in
gfortran by a sanitized compiler when compiling the testsuite. The patch
addresses all issues besides leaks (ASAN_OPTIONS="detect_leaks=false". Most of
the issues were about assuming certain kinds of data without explicitly
checking, e.g., taking a component-ref for an array-ref and similar.

So this patch only addresses the -fsanitize=address,undefined reports (without
leaks) for running the compiler. I liked to keep this patch small to get it
reviewed quickly. 

I see some other areas of work:

compile time part 2: address the leaks
testsuite run time: address the runtime issues (might have to be split in
	others and leaks, too)

So far, is this patch bootstrapping and regtesting fine on x86_64-linux/f23. Ok
for trunk?

Regards,
	Andre

PS: @Dominique: I will not commit before you are better and had the time to
test this.
-- 
Andre Vehreschild * Email: vehre ad gmx dot de

Attachment: pr78672_ctp1_v1.clog
Description: Text document

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 139ce88..4f835b3 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -186,7 +186,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec *ts,
       for (i = 0; i < len; i++)
 	dest[start+i] = rvalue->representation.string[i];
     }
-  else
+  else if (rvalue->value.character.string)
     memcpy (&dest[start], rvalue->value.character.string,
 	    len * sizeof (gfc_char_t));
 
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8afba84..4e4d17c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2803,6 +2803,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
   int i, n, na;
   unsigned long actual_size, formal_size;
   bool full_array = false;
+  gfc_ref *actual_arr_ref;
 
   actual = *ap;
 
@@ -2942,37 +2943,38 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	 and assumed-shape dummies, the string length needs to match
 	 exactly.  */
       if (a->expr->ts.type == BT_CHARACTER
-	   && a->expr->ts.u.cl && a->expr->ts.u.cl->length
-	   && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
-	   && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length
-	   && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
-	   && (f->sym->attr.pointer || f->sym->attr.allocatable
-	       || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
-	   && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
-			f->sym->ts.u.cl->length->value.integer) != 0))
-	 {
-	   if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
-	     gfc_warning (OPT_Wargument_mismatch,
-			  "Character length mismatch (%ld/%ld) between actual "
-			  "argument and pointer or allocatable dummy argument "
-			  "%qs at %L",
-			  mpz_get_si (a->expr->ts.u.cl->length->value.integer),
-			  mpz_get_si (f->sym->ts.u.cl->length->value.integer),
-			  f->sym->name, &a->expr->where);
-	   else if (where)
-	     gfc_warning (OPT_Wargument_mismatch,
-			  "Character length mismatch (%ld/%ld) between actual "
-			  "argument and assumed-shape dummy argument %qs "
-			  "at %L",
-			  mpz_get_si (a->expr->ts.u.cl->length->value.integer),
-			  mpz_get_si (f->sym->ts.u.cl->length->value.integer),
-			  f->sym->name, &a->expr->where);
-	   return 0;
-	 }
+	  && a->expr->ts.u.cl && a->expr->ts.u.cl->length
+	  && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && f->sym->ts.type == BT_CHARACTER && f->sym->ts.u.cl
+	  && f->sym->ts.u.cl->length
+	  && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+	  && (f->sym->attr.pointer || f->sym->attr.allocatable
+	      || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	  && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
+		       f->sym->ts.u.cl->length->value.integer) != 0))
+	{
+	  if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
+	    gfc_warning (OPT_Wargument_mismatch,
+			 "Character length mismatch (%ld/%ld) between actual "
+			 "argument and pointer or allocatable dummy argument "
+			 "%qs at %L",
+			 mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+			 mpz_get_si (f->sym->ts.u.cl->length->value.integer),
+			 f->sym->name, &a->expr->where);
+	  else if (where)
+	    gfc_warning (OPT_Wargument_mismatch,
+			 "Character length mismatch (%ld/%ld) between actual "
+			 "argument and assumed-shape dummy argument %qs "
+			 "at %L",
+			 mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+			 mpz_get_si (f->sym->ts.u.cl->length->value.integer),
+			 f->sym->name, &a->expr->where);
+	  return 0;
+	}
 
       if ((f->sym->attr.pointer || f->sym->attr.allocatable)
-	    && f->sym->ts.deferred != a->expr->ts.deferred
-	    && a->expr->ts.type == BT_CHARACTER)
+	  && f->sym->ts.deferred != a->expr->ts.deferred
+	  && a->expr->ts.type == BT_CHARACTER)
 	{
 	  if (where)
 	    gfc_error ("Actual argument at %L to allocatable or "
@@ -3039,13 +3041,28 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return 0;
 	}
 
+      /* Find the last array_ref.  */
+      actual_arr_ref = NULL;
+      if (a->expr->ref)
+	{
+	  gfc_ref *ref = a->expr->ref;
+
+	  do
+	    {
+	      if (ref->type == REF_ARRAY)
+		actual_arr_ref = ref;
+	      ref = ref->next;
+	    }
+	  while (ref != NULL);
+	}
+
       if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE
 	  && a->expr->expr_type == EXPR_VARIABLE
 	  && a->expr->symtree->n.sym->as
 	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
-	  && (a->expr->ref == NULL
-	      || (a->expr->ref->type == REF_ARRAY
-		  && a->expr->ref->u.ar.type == AR_FULL)))
+	  && (actual_arr_ref == NULL
+	      || (actual_arr_ref->type == REF_ARRAY
+		  && actual_arr_ref->u.ar.type == AR_FULL)))
 	{
 	  if (where)
 	    gfc_error ("Actual argument for %qs cannot be an assumed-size"
@@ -3196,14 +3213,14 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	}
 
       if (f->sym->attr.volatile_
-	  && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION
+	  && actual_arr_ref && actual_arr_ref->u.ar.type == AR_SECTION
 	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
 	{
 	  if (where)
 	    gfc_error ("Array-section actual argument at %L is "
 		       "incompatible with the non-assumed-shape "
 		       "dummy argument %qs due to VOLATILE attribute",
-		       &a->expr->where,f->sym->name);
+		       &a->expr->where, f->sym->name);
 	  return 0;
 	}
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index e727ade..713f272 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -4710,6 +4710,7 @@ load_omp_udrs (void)
 
       mio_lparen ();
       mio_pool_string (&name);
+      gfc_clear_ts (&ts);
       mio_typespec (&ts);
       if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0)
 	{
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 2e6ef2a..8173ba9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1019,7 +1019,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       layout_type (type);
     }
 
-  if (TYPE_NAME (type) != NULL_TREE
+  if (TYPE_NAME (type) != NULL_TREE && as->rank > 0
       && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE
       && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)))
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 8d7e881..3064e50 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2864,9 +2864,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
     return 0;
 
   m = wrhs.to_shwi ();
-  /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care
-     of the asymmetric range of the integer type.  */
-  n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m);
+  n = wi::abs (wrhs).to_shwi ();
 
   type = TREE_TYPE (lhs);
   sgn = tree_int_cst_sgn (rhs);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 5ca716b..d953ec8 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -6464,7 +6464,8 @@ gfc_trans_deallocate (gfc_code *code)
 		    && !(!last && expr->symtree->n.sym->attr.pointer))
 		{
 		  if (is_coarray && expr->rank == 0
-		      && (!last || !last->u.c.component->attr.dimension))
+		      && (!last || !last->u.c.component->attr.dimension)
+		      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
 		    {
 		      /* Add the ref to the data member only, when this is not
 			 a regular array or deallocate_alloc_comp will try to