diff mbox

[fortran] PR68566 ICE on using unusable array in reshape

Message ID 5701D3DB.9080807@charter.net
State New
Headers show

Commit Message

Jerry DeLisle April 4, 2016, 2:39 a.m. UTC 
On 04/02/2016 07:40 AM, Jerry DeLisle wrote:
> On 04/02/2016 05:42 AM, Dominique d'Humières wrote:
>>
>>> Le 2 avr. 2016 à 11:44, Dominique d'Humières <dominiq@lps.ens.fr> a écrit :
>>>
>>> Hi Jerry,
>>>
>>>> ...
>>>> I will add an additional test case for the original posted problem in the PR.
>>>> Two existing tests get exercised, changing the error message.  Finding the
>>>> problems earlier in the matchers I think is the right way to go. I am curious if
>>>> the old checks ever get triggered (I will look into that a little later.
>>>
>>> (2) Before your patch the errors were
>>>
>>> Error: Expression at (1) must be of INTEGER type, found REAL
>>>
>>> How difficult is it to restore the "found … « ?
> 
> I like that idea and not too difficult to do. ;)
> 

Here is an updated patch with Dominique's suggestion to tell what type was found
in the error message.

Patch includes a new test case fore the original test case in the PR and updates
of existing tests.

OK for trunk?

Jerry
diff mbox

Patch

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index 2fc9dfaf..1430e802 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -421,10 +421,15 @@  match_array_element_spec (gfc_array_spec *as)
   if (!gfc_expr_check_typed (*upper, gfc_current_ns, false))
     return AS_UNKNOWN;
 
-  if ((*upper)->expr_type == EXPR_FUNCTION && (*upper)->ts.type == BT_UNKNOWN
-      && (*upper)->symtree && strcmp ((*upper)->symtree->name, "null") == 0)
-    {
-      gfc_error ("Expecting a scalar INTEGER expression at %C");
+  if (((*upper)->expr_type == EXPR_CONSTANT
+	&& (*upper)->ts.type != BT_INTEGER) ||
+      ((*upper)->expr_type == EXPR_FUNCTION
+	&& (*upper)->ts.type == BT_UNKNOWN
+	&& (*upper)->symtree
+	&& strcmp ((*upper)->symtree->name, "null") == 0))
+    {
+      gfc_error ("Expecting a scalar INTEGER expression at %C, found %s",
+		 gfc_basic_typename ((*upper)->ts.type));
       return AS_UNKNOWN;
     }
 
@@ -448,10 +453,15 @@  match_array_element_spec (gfc_array_spec *as)
   if (!gfc_expr_check_typed (*upper, gfc_current_ns, false))
     return AS_UNKNOWN;
 
-  if ((*upper)->expr_type == EXPR_FUNCTION && (*upper)->ts.type == BT_UNKNOWN
-      && (*upper)->symtree && strcmp ((*upper)->symtree->name, "null") == 0)
+  if (((*upper)->expr_type == EXPR_CONSTANT
+	&& (*upper)->ts.type != BT_INTEGER) ||
+      ((*upper)->expr_type == EXPR_FUNCTION
+	&& (*upper)->ts.type == BT_UNKNOWN
+	&& (*upper)->symtree
+	&& strcmp ((*upper)->symtree->name, "null") == 0))
     {
-      gfc_error ("Expecting a scalar INTEGER expression at %C");
+      gfc_error ("Expecting a scalar INTEGER expression at %C, found %s",
+		 gfc_basic_typename ((*upper)->ts.type));
       return AS_UNKNOWN;
     }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 12a8f32e..a6310107 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5163,6 +5163,9 @@  gfc_simplify_reshape (gfc_expr *source, gfc_expr *shape_exp,
       || !is_constant_array_expr (order_exp))
     return NULL;
 
+  if (source->shape == NULL)
+    return NULL;
+
   /* Proceed with simplification, unpacking the array.  */
 
   mpz_init (index);
diff --git a/gcc/testsuite/gfortran.dg/pr36192.f90 b/gcc/testsuite/gfortran.dg/pr36192.f90
index df3bfd75..ebf95e35 100644
--- a/gcc/testsuite/gfortran.dg/pr36192.f90
+++ b/gcc/testsuite/gfortran.dg/pr36192.f90
@@ -3,7 +3,6 @@ 
 !
 program three_body
   real, parameter :: n = 2, d = 2
-  real, dimension(n,d) :: x      ! { dg-error "of INTEGER type|of INTEGER type" }
-  x(1,:) = (/ 1.0, 0.0 /)
+  real, dimension(n,d) :: x  ! { dg-error "Expecting a scalar INTEGER" }
+  x(1,:) = (/ 1.0, 0.0 /)    ! { dg-error "Unclassifiable" }
 end program three_body
-! { dg-prune-output "have constant shape" }
diff --git a/gcc/testsuite/gfortran.dg/pr36192_1.f90 b/gcc/testsuite/gfortran.dg/pr36192_1.f90
index 77df3176..687a465f 100644
--- a/gcc/testsuite/gfortran.dg/pr36192_1.f90
+++ b/gcc/testsuite/gfortran.dg/pr36192_1.f90
@@ -2,11 +2,11 @@ 
 ! PR fortran/36192
 program three_body
    real, parameter ::  n = 2, d = 2
-   real, dimension(n,d) :: x_hq ! { dg-error "of INTEGER type|of INTEGER type" }
+   real, dimension(n,d) :: x_hq ! { dg-error "Expecting a scalar INTEGER" }
    call step(x_hq)
    contains
    subroutine step(x)
       real, dimension(:,:), intent(in) :: x
    end subroutine step
 end program three_body
-! { dg-prune-output "must have constant shape" }
+! { dg-prune-output "Rank mismatch in argument" }
diff --git a/gcc/testsuite/gfortran.dg/real_dimension_1.f b/gcc/testsuite/gfortran.dg/real_dimension_1.f
index 73e9131a..3dd1a5af 100644
--- a/gcc/testsuite/gfortran.dg/real_dimension_1.f
+++ b/gcc/testsuite/gfortran.dg/real_dimension_1.f
@@ -1,7 +1,7 @@ 
 ! { dg-do compile }
-! PR 34305 - make sure there's an error message for specifying a
+! PR 34305 - Test for specifying a real as dimension
       program test
-      parameter (datasize = 1000) 
-      dimension idata (datasize)  ! { dg-error "must be of INTEGER type|must have constant shape" }
-      idata (1) = -1
+      real , parameter :: dsize = 1000
+      dimension idata (dsize) ! { dg-error "scalar INTEGER expression" }
+      idata (1) = -1    ! { dg-error "must have the pointer attribute" }
       end