Re: [PATCH] PR 68283 [5/6 Regression] ice: gfc_variable_attr(): Bad array reference

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

Hi Dominique,

I thought this one had been dealt with a long time since...

OK for trunk and 5-branch.

Thanks for dealing with it!

A

Paul

On 24 January 2016 at 12:22, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> 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 <dominiq@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  <tkoenig@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  <dominiq@lps.ens.fr>
> +
> +       PR fortran/68283
> +       gfortran.dg/pr68283.f90: New test.
> +
>  2016-01-24  Thomas Koenig  <tkoenig@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
>



-- 
The difference between genius and stupidity is; genius has its limits.

Albert Einstein