re PR fortran/78672 (Gfortran test suite failures with a sanitized compiler)

gcc/fortran/ChangeLog:

2016-12-14  Andre Vehreschild  <vehre@gcc.gnu.org>

	PR fortran/78672
	* array.c (gfc_find_array_ref): Add flag to return NULL when no ref is
	found instead of erroring out.
	* data.c (gfc_assign_data_value): Only constant expressions are valid
	for initializers.
	* gfortran.h: Reflect change of gfc_find_array_ref's signature.
	* interface.c (compare_actual_formal): Access the non-elemental
	array-ref.  Prevent taking a REF_COMPONENT for a REF_ARRAY.  Correct
	indentation.
	* module.c (load_omp_udrs): Clear typespec before reading into it.
	* trans-decl.c (gfc_build_qualified_array): Prevent accessing the array
	when it is a coarray.
	* trans-expr.c (gfc_conv_cst_int_power): Use wi::abs()-function instead
	of crutch preventing sanitizer's bickering here.
	* trans-stmt.c (gfc_trans_deallocate): Only get data-component when it
	is a descriptor-array here.

From-SVN: r243647

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 40b578325d1e34fa69419142dbb962fcdc9095ca..3b6cefcb371eb4b1862ef6e551a3857e50c2f154 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2016-12-14  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+       PR fortran/78672
+       * array.c (gfc_find_array_ref): Add flag to return NULL when no ref is
+       found instead of erroring out.
+       * data.c (gfc_assign_data_value): Only constant expressions are valid
+       for initializers.
+       * gfortran.h: Reflect change of gfc_find_array_ref's signature.
+       * interface.c (compare_actual_formal): Access the non-elemental
+       array-ref.  Prevent taking a REF_COMPONENT for a REF_ARRAY.  Correct
+       indentation.
+       * module.c (load_omp_udrs): Clear typespec before reading into it.
+       * trans-decl.c (gfc_build_qualified_array): Prevent accessing the array
+       when it is a coarray.
+       * trans-expr.c (gfc_conv_cst_int_power): Use wi::abs()-function instead
+       of crutch preventing sanitizer's bickering here.
+       * trans-stmt.c (gfc_trans_deallocate): Only get data-component when it
+       is a descriptor-array here.
+
 2016-12-13  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/78798

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 154b860689747490bb6f3407b25265e896468328..c531522f71f2f8906cbbf6ab180dc76efa8d8185 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -2563,7 +2563,7 @@ cleanup:
    characterizes the reference.  */
 
 gfc_array_ref *
-gfc_find_array_ref (gfc_expr *e)
+gfc_find_array_ref (gfc_expr *e, bool allow_null)
 {
   gfc_ref *ref;
 
@@ -2573,7 +2573,12 @@ gfc_find_array_ref (gfc_expr *e)
       break;
 
   if (ref == NULL)
-    gfc_internal_error ("gfc_find_array_ref(): No ref found");
+    {
+      if (allow_null)
+       return NULL;
+      else
+       gfc_internal_error ("gfc_find_array_ref(): No ref found");
+    }
 
   return &ref->u.ar;
 }

diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 139ce880534d5d0c0049a1a3d23485bf342cf9a6..ea19732ccc34aef5c54eb3f79e13e3efefcbdfcf 100644 (file)
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -483,7 +483,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
 
   if (ref || last_ts->type == BT_CHARACTER)
     {
-      if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+      /* An initializer has to be constant.  */
+      if (rvalue->expr_type != EXPR_CONSTANT
+         || (lvalue->ts.u.cl->length == NULL
+             && !(ref && ref->u.ss.length != NULL)))
        return false;
       expr = create_character_initializer (init, last_ts, ref, rvalue);
     }

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index da653363712ccc26e280b0fa1eef84f16f698a13..ae1a01b0ec4edf83454074141b274e1f40c4d102 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3214,7 +3214,7 @@ bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *));
 bool gfc_array_size (gfc_expr *, mpz_t *);
 bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
 bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
-gfc_array_ref *gfc_find_array_ref (gfc_expr *);
+gfc_array_ref *gfc_find_array_ref (gfc_expr *, bool a = false);
 tree gfc_conv_array_initializer (tree type, gfc_expr *);
 bool spec_size (gfc_array_spec *, mpz_t *);
 bool spec_dimen_size (gfc_array_spec *, int, mpz_t *);

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 90f46e56e4d3b54615ccb548df41d569a3476bba..a6f4e7204e1fe83ea64634859a7446ff8454f876 100644 (file)
--- 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_array_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 "
@@ -3195,15 +3197,20 @@ 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)
+       actual_arr_ref = gfc_find_array_ref (a->expr, true);
+
       if (f->sym->attr.volatile_
-         && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION
+         && actual_arr_ref && actual_arr_ref->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 e727adebc99b03373a12e09216aee8a465d07d30..713f27271de996ba5c11380561a58f23705d357c 100644 (file)
--- 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 f659a486ec98b1b619bc74b2fa92efa546984f92..a7a5e2a4b6b6747e5360d925668e031762917cb9 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1053,7 +1053,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 cbfad0babd90a6feabad86668f9bd0e2aefaa2f5..2f45d40bec72350b0768a24a1a6e2061f3f97be0 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2864,9 +2864,9 @@ 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);
+  /* Use the wide_int's routine to reliably get the absolute value on all
+     platforms.  Then convert it to a HOST_WIDE_INT like above.  */
+  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 d34bdba9628c9f5adf1c594316e5a9d18d80ae89..d9e185f292790dcb199701b883957faa74fb5bc4 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -6483,7 +6483,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