Fortran] PR 92996 – fix rank resolution EXPR_ARRAY

        PR fortran/92996
        gcc/fortran/
        * expr.c (simplify_parameter_variable): Call gfc_resolve_ref and
        gfc_expression_rank; fix location info.
        * gfortran.h (gfc_resolve_ref, gfc_expression_rank): Declare.
        * match.c (gfc_match_stopcode): Remove redundant setting of
        gfc_init_expr_flag; early return if gfc_simplify_expr has an error.
        * resolve.c (gfc_expression_rank): Renamed from expression_rank;
        minor cleanup.
        (gfc_resolve_ref): Removed static and renamed from resolve_ref.
        (resolve_variable, resolve_typebound_function,
        resolve_typebound_subroutine, resolve_ppc_call, resolve_expr_ppc,
        gfc_resolve_expr, resolve_procedure): Update calls.

        PR fortran/92996
        gcc/testsuite/
        * gfortran.dg/array_simplify_4.f90: New.
        * gfortran.dg/pr91565.f90: Update dg-error.
        * gfortran.dg/pr91801.f90: Likewise.

From-SVN: r279638

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d382ac056668b84dd19aba1668850e54d3e5cf65..8d480c5ce125204fd7dd0542af9e5ffed527da76 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2019-12-20  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92996
+       * expr.c (simplify_parameter_variable): Call gfc_resolve_ref and
+       gfc_expression_rank; fix location info.
+       * gfortran.h (gfc_resolve_ref, gfc_expression_rank): Declare.
+       * match.c (gfc_match_stopcode): Remove redundant setting of
+       gfc_init_expr_flag; early return if gfc_simplify_expr has an error.
+       * resolve.c (gfc_expression_rank): Renamed from expression_rank;
+       minor cleanup.
+       (gfc_resolve_ref): Removed static and renamed from resolve_ref.
+       (resolve_variable, resolve_typebound_function,
+       resolve_typebound_subroutine, resolve_ppc_call, resolve_expr_ppc,
+       gfc_resolve_expr, resolve_procedure): Update calls.
+
 2019-12-20  Tobias Burnus  <tobias@codesourcery.com>
 
        * openmp.c (resolve_omp_clauses): Move is-coindexed check from here ...

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 9e3c8c422972e3f11e8ab6be27fdf30987a80eec..fc67a9dd5b0e397447becdabcbaed1bf8d66b8cd 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2044,6 +2044,15 @@ simplify_parameter_variable (gfc_expr *p, int type)
   gfc_expr *e;
   bool t;
 
+  /* Set rank and check array ref; as resolve_variable calls
+     gfc_simplify_expr, call gfc_resolve_ref + gfc_expression_rank instead.  */
+  if (!gfc_resolve_ref (p))
+    {
+      gfc_error_check ();
+      return false;
+    }
+  gfc_expression_rank (p);
+
   if (gfc_is_size_zero_array (p))
     {
       if (p->expr_type == EXPR_ARRAY)
@@ -2073,6 +2082,7 @@ simplify_parameter_variable (gfc_expr *p, int type)
   if (e->expr_type != EXPR_CONSTANT && p->ref != NULL)
     e->ref = gfc_copy_ref (p->ref);
   t = gfc_simplify_expr (e, type);
+  e->where = p->where;
 
   /* Only use the simplification if it eliminated all subobject references.  */
   if (t && !e->ref)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7919b690ec0709619c35c828a677b7187412248d..b38238a9faaea34888c0246f3bda8557b3ad5ec7 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3352,6 +3352,8 @@ void gfc_free_statements (gfc_code *);
 void gfc_free_association_list (gfc_association_list *);
 
 /* resolve.c */
+void gfc_expression_rank (gfc_expr *);
+bool gfc_resolve_ref (gfc_expr *);
 bool gfc_resolve_expr (gfc_expr *);
 void gfc_resolve (gfc_namespace *);
 void gfc_resolve_code (gfc_code *, gfc_namespace *);

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index b5945049de550ba61af48842a248a31ab7555964..d3e3abcb700f3fe374b1b18a7945739f60531fce 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3073,7 +3073,8 @@ gfc_match_stopcode (gfc_statement st)
 
   if (e != NULL)
     {
-      gfc_simplify_expr (e, 0);
+      if (!gfc_simplify_expr (e, 0))
+       goto cleanup;
 
       /* Test for F95 and F2003 style STOP stop-code.  */
       if (e->expr_type != EXPR_CONSTANT && (f95 || f03))
@@ -3085,9 +3086,7 @@ gfc_match_stopcode (gfc_statement st)
 
       /* Use the machinery for an initialization expression to reduce the
         stop-code to a constant.  */
-      gfc_init_expr_flag = true;
       gfc_reduce_init_expr (e);
-      gfc_init_expr_flag = false;
 
       /* Test for F2008 style STOP stop-code.  */
       if (e->expr_type != EXPR_CONSTANT && f08)

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index b437c59550074b23e2f664e33a35dc833dc646e1..92ed413fe0a0b52eb6cb2d06f673b340719b44ff 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5189,8 +5189,8 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 
 /* Resolve subtype references.  */
 
-static bool
-resolve_ref (gfc_expr *expr)
+bool
+gfc_resolve_ref (gfc_expr *expr)
 {
   int current_part_dimension, n_components, seen_part_dimension;
   gfc_ref *ref, **prev;
@@ -5359,7 +5359,7 @@ fail:
    examining the base symbol and any reference structures it may have.  */
 
 void
-expression_rank (gfc_expr *e)
+gfc_expression_rank (gfc_expr *e)
 {
   gfc_ref *ref;
   int i, rank;
@@ -5374,14 +5374,8 @@ expression_rank (gfc_expr *e)
        goto done;
       /* Constructors can have a rank different from one via RESHAPE().  */
 
-      if (e->symtree == NULL)
-       {
-         e->rank = 0;
-         goto done;
-       }
-
-      e->rank = (e->symtree->n.sym->as == NULL)
-               ? 0 : e->symtree->n.sym->as->rank;
+      e->rank = ((e->symtree == NULL || e->symtree->n.sym->as == NULL)
+                ? 0 : e->symtree->n.sym->as->rank);
       goto done;
     }
 
@@ -5406,7 +5400,7 @@ expression_rank (gfc_expr *e)
        {
          /* Figure out the rank of the section.  */
          if (rank != 0)
-           gfc_internal_error ("expression_rank(): Two array specs");
+           gfc_internal_error ("gfc_expression_rank(): Two array specs");
 
          for (i = 0; i < ref->u.ar.dimen; i++)
            if (ref->u.ar.dimen_type[i] == DIMEN_RANGE
@@ -5686,7 +5680,7 @@ resolve_variable (gfc_expr *e)
        }
     }
 
-  if (e->ref && !resolve_ref (e))
+  if (e->ref && !gfc_resolve_ref (e))
     return false;
 
   if (sym->attr.flavor == FL_PROCEDURE
@@ -5848,7 +5842,7 @@ resolve_procedure:
     }
 
   if (t)
-    expression_rank (e);
+    gfc_expression_rank (e);
 
   if (t && flag_coarray == GFC_FCOARRAY_LIB && gfc_is_coindexed (e))
     add_caf_get_intrinsic (e);
@@ -6642,7 +6636,7 @@ resolve_typebound_function (gfc_expr* e)
   if (st == NULL)
     return resolve_compcall (e, NULL);
 
-  if (!resolve_ref (e))
+  if (!gfc_resolve_ref (e))
     return false;
 
   /* Get the CLASS declared type.  */
@@ -6775,7 +6769,7 @@ resolve_typebound_subroutine (gfc_code *code)
   if (st == NULL)
     return resolve_typebound_call (code, NULL, NULL);
 
-  if (!resolve_ref (code->expr1))
+  if (!gfc_resolve_ref (code->expr1))
     return false;
 
   /* Get the CLASS declared type.  */
@@ -6838,7 +6832,7 @@ resolve_ppc_call (gfc_code* c)
   if (!comp->attr.subroutine)
     gfc_add_subroutine (&comp->attr, comp->name, &c->expr1->where);
 
-  if (!resolve_ref (c->expr1))
+  if (!gfc_resolve_ref (c->expr1))
     return false;
 
   if (!update_ppc_arglist (c->expr1))
@@ -6881,7 +6875,7 @@ resolve_expr_ppc (gfc_expr* e)
   if (!comp->attr.function)
     gfc_add_function (&comp->attr, comp->name, &e->where);
 
-  if (!resolve_ref (e))
+  if (!gfc_resolve_ref (e))
     return false;
 
   if (!resolve_actual_arglist (e->value.function.actual, comp->attr.proc,
@@ -7011,7 +7005,7 @@ gfc_resolve_expr (gfc_expr *e)
       break;
 
     case EXPR_SUBSTRING:
-      t = resolve_ref (e);
+      t = gfc_resolve_ref (e);
       break;
 
     case EXPR_CONSTANT:
@@ -7025,14 +7019,14 @@ gfc_resolve_expr (gfc_expr *e)
 
     case EXPR_ARRAY:
       t = false;
-      if (!resolve_ref (e))
+      if (!gfc_resolve_ref (e))
        break;
 
       t = gfc_resolve_array_constructor (e);
       /* Also try to expand a constructor.  */
       if (t)
        {
-         expression_rank (e);
+         gfc_expression_rank (e);
          if (gfc_is_constant_expr (e) || gfc_is_expandable_expr (e))
            gfc_expand_constructor (e, false);
        }
@@ -7051,7 +7045,7 @@ gfc_resolve_expr (gfc_expr *e)
       break;
 
     case EXPR_STRUCTURE:
-      t = resolve_ref (e);
+      t = gfc_resolve_ref (e);
       if (!t)
        break;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8f2aba2f7edf7241c00f80d7b0d8011f712e9a52..d5bd666eec3a9507a7432b547f82a771e470a7ee 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2019-12-20  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92996
+       * gfortran.dg/array_simplify_4.f90: New.
+       * gfortran.dg/pr91565.f90: Update dg-error.
+       * gfortran.dg/pr91801.f90: Likewise.
+
 2019-12-20  Tobias Burnus  <tobias@codesourcery.com>
 
        * gfortran.dg/goacc/coindexed-1.f90: New.

diff --git a/gcc/testsuite/gfortran.dg/array_simplify_4.f90 b/gcc/testsuite/gfortran.dg/array_simplify_4.f90
new file mode 100644 (file)
index 0000000..2aa522b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_simplify_4.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/92996
+!
+! Contributed by G. Steinmetz
+!
+
+module m
+  integer, parameter :: d(2) = [0,0]
+end module m
+
+subroutine one
+use m
+print size([1,2],dim=d(1)) ! { dg-error "'dim' argument of 'size' intrinsic at .1. is not a valid dimension index" }
+end
+
+subroutine two
+complex, parameter :: x = 1
+
+stop x  ! { dg-error "STOP code at .1. must be either INTEGER or CHARACTER type" }
+end
+
+program p
+   integer, parameter :: a(2) = [1, 2]
+   stop a(1) ! OK
+   stop a ! { dg-error "STOP code at .1. must be scalar" }
+   stop a(1,1) ! { dg-error "Rank mismatch in array reference at .1. .2/1." }
+end

diff --git a/gcc/testsuite/gfortran.dg/pr91565.f90 b/gcc/testsuite/gfortran.dg/pr91565.f90
index b43a57acf1357e6f187ba2a2e3524650189bd54d..e4e121c717acf5a4cabd1c8fdda45ed2b8091069 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pr91565.f90
+++ b/gcc/testsuite/gfortran.dg/pr91565.f90
@@ -2,16 +2,16 @@
 ! PR fortran/91565
 ! Contributed by Gerhard Steinmetz
 program p
-   integer, parameter :: a(2) = [2,2]              ! { dg-error "\(1\)" }
-   print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "not a permutation" }
+   integer, parameter :: a(2) = [2,2]
+   print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "ORDER at .1. is not a permutation of the size of SHAPE at .2." }
 end
 
 subroutine foo
-   integer, parameter :: a(1) = 1                  ! { dg-error "\(1\)" }
+   integer, parameter :: a(1) = 1
    print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "are different" }
 end
 
 subroutine bar
-   integer, parameter :: a(1,2) = 1                ! { dg-error "\(1\)" }
+   integer, parameter :: a(1,2) = 1
    print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "are different" }
 end

diff --git a/gcc/testsuite/gfortran.dg/pr91801.f90 b/gcc/testsuite/gfortran.dg/pr91801.f90
index d2d82b88464b7c090c05a4c24b395cdaf01c4ea4..809068b9659410e1d0dd797b0916618e9d32b40e 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pr91801.f90
+++ b/gcc/testsuite/gfortran.dg/pr91801.f90
@@ -2,6 +2,6 @@
 ! PR fortran/91801
 ! Code contributed by Gerhard Steinmetz
 program p
-   integer, parameter :: a(2) = [2,0]              ! { dg-error "Element with a value of" }
-   print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "for the RESHAPE intrinsic near" }
+   integer, parameter :: a(2) = [2,0]
+   print *, reshape([1,2,3,4,5,6], [2,3], order=a) ! { dg-error "Element with a value of 0 in ORDER at .1. must be in the range .1, ..., 2. for the RESHAPE intrinsic near .2." }
 end