procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: Fix some select rank issues [PR97694 and 97723].

Browse source 
2020-12-27  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/97694
	PR fortran/97723
	* check.c (allocatable_check): Select rank temporaries are
	permitted even though they are treated as associate variables.
	* resolve.c (gfc_resolve_code): Break on select rank as well as
	select type so that the block os resolved.
	* trans-stmt.c (trans_associate_var): Class associate variables
	that are optional dummies must use the backend_decl.

gcc/testsuite/
	PR fortran/97694
	PR fortran/97723
	* gfortran.dg/select_rank_5.f90: New test.
This commit is contained in:
Paul Thomas 2020-12-27 14:59:38 +00:00
parent 0e283e2c9f
commit c4a6789815
4 changed files with 55 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gcc/fortran/check.c
View file

@ -975,7 +975,8 @@ allocatable_check (gfc_expr *e, int n)
symbol_attribute attr;
attr = gfc_variable_attr (e, NULL);
if (!attr.allocatable || attr.associate_var)
if (!attr.allocatable
|| (attr.associate_var && !attr.select_rank_temporary))
{
gfc_error ("%qs argument of %qs intrinsic at %L must be ALLOCATABLE",
gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,

5
gcc/fortran/resolve.c
View file

@ -11776,8 +11776,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
gfc_resolve_omp_do_blocks (code, ns);
break;
case EXEC_SELECT_TYPE:
/* Blocks are handled in resolve_select_type because we have
to transform the SELECT TYPE into ASSOCIATE first. */
case EXEC_SELECT_RANK:
/* Blocks are handled in resolve_select_type/rank because we
have to transform the SELECT TYPE into ASSOCIATE first. */
break;
case EXEC_DO_CONCURRENT:
gfc_do_concurrent_flag = 1;

2
gcc/fortran/trans-stmt.c
View file

@ -1784,7 +1784,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
if (e->ts.type == BT_CLASS)
{
/* Go straight to the class data. */
if (sym2->attr.dummy)
if (sym2->attr.dummy && !sym2->attr.optional)
{
class_decl = DECL_LANG_SPECIFIC (sym2->backend_decl) ?
GFC_DECL_SAVED_DESCRIPTOR (sym2->backend_decl) :

44
gcc/testsuite/gfortran.dg/select_rank_5.f90 Normal file
View file

@ -0,0 +1,44 @@
! { dg-do run }
!
! Test the fixes for PR97723 and PR97694.
!
! Contributed by Martin <mscfd@gmx.net>
!
module mod
implicit none
private
public cssel
contains
function cssel(x) result(s)
character(len=:), allocatable :: s
class(*), dimension(..), optional, intent(in) :: x
if (present(x)) then
select rank (x)
rank (0)
s = '0' ! PR97723: ‘assign’ at (1) is not a function
! PR97694: ICE in trans-stmt.c(trans_associate_var)
rank (1)
s = '1' ! PR97723: ‘assign’ at (1) is not a function
rank default
s = '?' ! PR97723: ‘assign’ at (1) is not a function
end select
else
s = '-'
end if
end function cssel
end module mod
program classstar_rank
use mod
implicit none
integer :: x
real, dimension(1:3) :: y
logical, dimension(1:2,1:2) :: z
if (any ([cssel(x),cssel(y),cssel(z),cssel()] .ne. ['0','1','?','-'])) stop 1
end program classstar_rank