re PR fortran/91729 (ICE in gfc_match_select_rank, at fortran/match.c:6586)
2019-09-23 Paul Thomas <pault@gcc.gnu.org> PR fortran/91729 * match.c (gfc_match_select_rank): Initialise 'as' to NULL. Check for a symtree in the selector expression before trying to assign a value to 'as'. Revert to gfc_error and go to cleanup after setting a MATCH_ERROR. 2019-09-23 Paul Thomas <pault@gcc.gnu.org> PR fortran/91729 * gfortran.dg/select_rank_2.f90 : Add two more errors in foo2. * gfortran.dg/select_rank_3.f90 : New test. From-SVN: r276051
This commit is contained in:
parent
b7bb3d3580
commit
158ab20432
|
@ -1,3 +1,11 @@
|
|||
2019-09-23 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/91729
|
||||
* match.c (gfc_match_select_rank): Initialise 'as' to NULL.
|
||||
Check for a symtree in the selector expression before trying to
|
||||
assign a value to 'as'. Revert to gfc_error and go to cleanup
|
||||
after setting a MATCH_ERROR.
|
||||
|
||||
2019-09-20 Tobias Burnus <tobias@codesourcery.com>
|
||||
|
||||
PR fortran/78260
|
||||
|
|
|
@ -6510,7 +6510,7 @@ gfc_match_select_rank (void)
|
|||
char name[GFC_MAX_SYMBOL_LEN];
|
||||
gfc_symbol *sym, *sym2;
|
||||
gfc_namespace *ns = gfc_current_ns;
|
||||
gfc_array_spec *as;
|
||||
gfc_array_spec *as = NULL;
|
||||
|
||||
m = gfc_match_label ();
|
||||
if (m == MATCH_ERROR)
|
||||
|
@ -6538,13 +6538,21 @@ gfc_match_select_rank (void)
|
|||
}
|
||||
|
||||
sym = expr1->symtree->n.sym;
|
||||
sym2 = expr2->symtree->n.sym;
|
||||
|
||||
as = sym2->ts.type == BT_CLASS ? CLASS_DATA (sym2)->as : sym2->as;
|
||||
if (expr2->symtree)
|
||||
{
|
||||
sym2 = expr2->symtree->n.sym;
|
||||
as = sym2->ts.type == BT_CLASS ? CLASS_DATA (sym2)->as : sym2->as;
|
||||
}
|
||||
|
||||
if (expr2->expr_type != EXPR_VARIABLE
|
||||
|| !(as && as->type == AS_ASSUMED_RANK))
|
||||
gfc_error_now ("The SELECT RANK selector at %C must be an assumed "
|
||||
"rank variable");
|
||||
{
|
||||
gfc_error ("The SELECT RANK selector at %C must be an assumed "
|
||||
"rank variable");
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
}
|
||||
|
||||
if (expr2->ts.type == BT_CLASS)
|
||||
{
|
||||
|
@ -6583,12 +6591,20 @@ gfc_match_select_rank (void)
|
|||
return m;
|
||||
}
|
||||
|
||||
sym = expr1->symtree->n.sym;
|
||||
as = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->as : sym->as;
|
||||
if (expr1->symtree)
|
||||
{
|
||||
sym = expr1->symtree->n.sym;
|
||||
as = sym->ts.type == BT_CLASS ? CLASS_DATA (sym)->as : sym->as;
|
||||
}
|
||||
|
||||
if (expr1->expr_type != EXPR_VARIABLE
|
||||
|| !(as && as->type == AS_ASSUMED_RANK))
|
||||
gfc_error_now ("The SELECT RANK selector at %C must be an assumed "
|
||||
"rank variable");
|
||||
{
|
||||
gfc_error("The SELECT RANK selector at %C must be an assumed "
|
||||
"rank variable");
|
||||
m = MATCH_ERROR;
|
||||
goto cleanup;
|
||||
}
|
||||
}
|
||||
|
||||
m = gfc_match (" )%t");
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2019-09-23 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/91729
|
||||
* gfortran.dg/select_rank_2.f90 : Add two more errors in foo2.
|
||||
* gfortran.dg/select_rank_3.f90 : New test.
|
||||
|
||||
2019-09-23 Rainer Orth <ro@CeBiTec.Uni-Bielefeld.DE>
|
||||
|
||||
* gnat.dg/system_info1.adb: Sort dg-do target list.
|
||||
|
|
|
@ -8,9 +8,9 @@ subroutine foo1 (arg)
|
|||
integer :: i
|
||||
integer, dimension(3) :: arg
|
||||
select rank (arg) ! { dg-error "must be an assumed rank variable" }
|
||||
rank (3)
|
||||
rank (3) ! { dg-error "Unexpected RANK statement" }
|
||||
print *, arg
|
||||
end select
|
||||
end select ! { dg-error "Expecting END SUBROUTINE" }
|
||||
end
|
||||
|
||||
subroutine foo2 (arg)
|
||||
|
|
|
@ -0,0 +1,21 @@
|
|||
! { dg-do compile }
|
||||
!
|
||||
! Test the fix for PR91729
|
||||
!
|
||||
! Contributed by Gerhardt Steinmetz <gscfq@t-online.de>
|
||||
!
|
||||
subroutine s(x)
|
||||
integer :: x(..)
|
||||
select rank (-x) ! { dg-error "must be an assumed rank" }
|
||||
rank (1) ! { dg-error "Unexpected RANK statement" }
|
||||
print *, x ! { dg-error "may only be used as actual argument" }
|
||||
end select ! { dg-error "Expecting END SUBROUTINE" }
|
||||
end
|
||||
|
||||
subroutine t(x)
|
||||
integer :: x(..)
|
||||
select rank (z => -x) ! { dg-error "must be an assumed rank" }
|
||||
rank (1) ! { dg-error "Unexpected RANK statement" }
|
||||
print *, z
|
||||
end select ! { dg-error "Expecting END SUBROUTINE" }
|
||||
end
|
Loading…
Reference in New Issue