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