Fortran: Fix some select rank issues [PR97694 and 97723].
Hi All,
Unlike select type, select rank selectors retain the allocatable attribute.
This is corrected by the chunk in check.c. Note the trailing whitespace
corrections. Resolution of select rank construct must be done in the same
way as select type and so the break has been added to ensure that the block
is resolved in resolve_select_rank. The final chunk prevents segfaults for
class associate variables that are optional dummies, since these apparently
are not adorned with the GFC_DECL_SAVED_DESCRIPTOR.
Regtests OK on FC31/x86_64 - OK for master?
Cheers
Paul
2020-12-12 Paul Thomas <pa...@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.
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 1e64fab3401..d8829e42b18 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -289,7 +289,7 @@ bin2real (gfc_expr *x, int kind)
}
-/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2real ()
+/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2real ()
converts the string into a REAL of the appropriate kind. The treatment
of the sign bit is processor dependent. */
@@ -377,12 +377,12 @@ gfc_boz2real (gfc_expr *x, int kind)
}
-/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2int ()
+/* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2int ()
converts the string into an INTEGER of the appropriate kind. The
treatment of the sign bit is processor dependent. If the converted
value exceeds the range of the type, then wrap-around semantics are
applied. */
-
+
bool
gfc_boz2int (gfc_expr *x, int kind)
{
@@ -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,
@@ -3232,7 +3233,7 @@ gfc_check_intconv (gfc_expr *x)
|| strcmp (gfc_current_intrinsic, "long") == 0)
{
gfc_error ("%qs intrinsic subprogram at %L has been deprecated. "
- "Use INT intrinsic subprogram.", gfc_current_intrinsic,
+ "Use INT intrinsic subprogram.", gfc_current_intrinsic,
&x->where);
return false;
}
@@ -3965,7 +3966,7 @@ gfc_check_findloc (gfc_actual_arglist *ap)
/* Check the kind of the characters argument match. */
if (a1 && v1 && a->ts.kind != v->ts.kind)
goto incompat;
-
+
d = ap->next->next->expr;
m = ap->next->next->next->expr;
k = ap->next->next->next->next->expr;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0a8f90775ab..891571c0864 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index adc6b8fefb5..ab99e579461 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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) :
! { dg-do run }
!
! Test the fixes for PR97723 and PR97694.
!
! Contributed by Martin <ms...@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
