Dear all,

Is the following patch OK for trunk and the gcc5 branch? see the thread 
starting at https://gcc.gnu.org/ml/fortran/2015-11/msg00057.html and 
https://gcc.gnu.org/ml/fortran/2015-11/msg00072.html.

Dominique

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog       (revision 232774)
+++ gcc/fortran/ChangeLog       (working copy)
@@ -1,3 +1,9 @@
+2016-01-24  Dominique d'Humieres <domi...@lps.ens.fr>
+
+       PR fortran/68283
+       * primary.c (gfc_variable_attr): revert revision r221955,
+       call gfc_internal_error only if there is no error.
+
 2016-01-24  Thomas Koenig  <tkoe...@gcc.gnu.org>
 
        PR fortran/66094
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c       (revision 232774)
+++ gcc/fortran/primary.c       (working copy)
@@ -2194,7 +2194,7 @@
 symbol_attribute
 gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
 {
-  int dimension, codimension, pointer, allocatable, target, n;
+  int dimension, codimension, pointer, allocatable, target;
   symbol_attribute attr;
   gfc_ref *ref;
   gfc_symbol *sym;
@@ -2253,22 +2253,9 @@
          case AR_UNKNOWN:
            /* If any of start, end or stride is not integer, there will
               already have been an error issued.  */
-           for (n = 0; n < ref->u.ar.as->rank; n++)
-             {
-               int errors;
-               gfc_get_errors (NULL, &errors);
-               if (((ref->u.ar.start[n]
-                     && ref->u.ar.start[n]->ts.type == BT_UNKNOWN)
-                    ||
-                    (ref->u.ar.end[n]
-                     && ref->u.ar.end[n]->ts.type == BT_UNKNOWN)
-                    ||
-                    (ref->u.ar.stride[n]
-                     && ref->u.ar.stride[n]->ts.type == BT_UNKNOWN))
-                   && errors > 0)
-                 break;
-             }
-           if (n == ref->u.ar.as->rank)
+           int errors;
+           gfc_get_errors (NULL, &errors);
+           if (errors == 0)
              gfc_internal_error ("gfc_variable_attr(): Bad array reference");
          }
 
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog     (revision 232774)
+++ gcc/testsuite/ChangeLog     (working copy)
@@ -1,3 +1,8 @@
+2016-01-24  Dominique d'Humieres  <domi...@lps.ens.fr>
+
+       PR fortran/68283
+       gfortran.dg/pr68283.f90: New test.
+
 2016-01-24  Thomas Koenig  <tkoe...@gcc.gnu.org>
 
        PR fortran/66094
Index: gcc/testsuite/gfortran.dg/pr68283.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68283.f90       (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr68283.f90       (working copy)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+MODULE neb_utils
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: dp=8
+  TYPE neb_var_type
+     REAL(KIND=dp), DIMENSION(:, :),  POINTER  :: xyz, int, wrk
+  END TYPE neb_var_type
+CONTAINS
+  SUBROUTINE get_neb_force()
+    INTEGER                                  :: i
+    TYPE(neb_var_type), POINTER              :: forces
+    REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: dtmp1, wrk
+    dtmp1 = forces%wrk(:,i)-dot_product_band ! { dg-error "Symbol 
'dot_product_band' at .1. has no IMPLICIT type" }
+  END SUBROUTINE get_neb_force
+END MODULE neb_utils

Reply via email to