Hi all,

here is another small patch that fixes two invalid test cases in the
test suite and also fixes the check that was supposed to reject these
cases (but failed).

Regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2018-02-14  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/84385
    * match.c (gfc_match_select_type): Fix check for selector in
    SELECT TYPE statement.


2018-02-14  Janus Weil  <ja...@gcc.gnu.org>

    PR fortran/84385
    * gfortran.dg/allocate_with_source_22.f03: Fix invalid test case.
    * gfortran.dg/allocate_with_source_23.f90: Ditto.
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 257635)
+++ gcc/fortran/match.c (working copy)
@@ -6201,9 +6201,10 @@ gfc_match_select_type (void)
                     || CLASS_DATA (expr1)->attr.codimension)
                 && expr1->ref
                 && expr1->ref->type == REF_ARRAY
+                && expr1->ref->u.ar.type == AR_FULL
                 && expr1->ref->next == NULL);
 
-  /* Check for F03:C811.  */
+  /* Check for F03:C811 (F08:C835).  */
   if (!expr2 && (expr1->expr_type != EXPR_VARIABLE
                 || (!class_array && expr1->ref != NULL)))
     {
Index: gcc/testsuite/gfortran.dg/allocate_with_source_22.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_22.f03       (revision 
257635)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_22.f03       (working copy)
@@ -27,7 +27,7 @@ subroutine test_class()
   ! with -fcheck=bounds.
   if (size(b) /= 4) call abort()
   if (any(b(1:2)%i /= [ 1,2])) call abort()
-  select type (b(1))
+  select type (b1 => b(1))
     class is (tt)
       continue
     class default
Index: gcc/testsuite/gfortran.dg/allocate_with_source_23.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_23.f03       (revision 
257635)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_23.f03       (working copy)
@@ -28,7 +28,7 @@ subroutine test_class_correct()
   allocate(b(1:4), source=a(1))
   if (size(b) /= 4) call abort()
   if (any(b(:)%i /= [ 1,1,1,1])) call abort()
-  select type (b(1))
+  select type (b1 => b(1))
     class is (tt)
       continue
     class default
@@ -46,7 +46,7 @@ subroutine test_class_fail()
   allocate(b(1:4), source=a) ! Fail expected: sizes do not conform
   if (size(b) /= 4) call abort()
   if (any(b(1:2)%i /= [ 1,2])) call abort()
-  select type (b(1))
+  select type (b1 => b(1))
     class is (tt)
       continue
     class default

Reply via email to