This patch fixes 3 testcases that violate F2018 C838 by passing an
assumed-rank argument to a procedure via an assumed-sized dummy, by
wrapping the call in a SELECT RANK construct. But wait, there's more!
This triggered an ICE due to a null pointer dereference in the code that
handles the associated variable in the SELECT RANK. I fixed that by
copying the idiom used in other places for GFC_DECL_SAVED_DESCRIPTOR, so
now all the tests pass again.
Is this OK to commit? I confess I'm not certain whether adding the
SELECT RANK causes the testcases now to do something different from what
they were originally trying to test, but they never should have worked
as originally written anyway. We were just not previously diagnosing
the C838 violations without the other patch I just posted to do that.
-Sandra
commit dd48922d40542eb1b9d17a78fcb3a7cfb857d555
Author: Sandra Loosemore <san...@codesourcery.com>
Date: Sun Sep 19 17:23:58 2021 -0700
Fortran: Fix testcases that violate C838, + revealed ICE
The three test cases fixed in this patch violated F2018 C838, which
only allows passing an assumed-rank argument to an assumed-rank dummy.
Wrapping the call in "select rank" revealed a null pointer dereference
which is fixed by guarding the use of the result of
GFC_DECL_SAVED_DESCRIPTOR similar to what is already done elsewhere.
2021-09-19 Sandra Loosemore <san...@codesourcery.com>
gcc/fortran/
* trans-stmt.c (trans_associate_var): Check that result of
GFC_DECL_SAVED_DESCRIPTOR is not null before using it.
gcc/testsuite/
* gfortran.dg/assumed_rank_18.f90 (g): Wrap call to h in
select rank.
* gfortran.dg/assumed_type_10.f90 (test_array): Likewise for
call to test_lib.
* gfortran.dg/assumed_type_11.f90 (test_array): Likewise.
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 11df186..a8ff473 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1788,9 +1788,10 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
/* Go straight to the class data. */
if (sym2->attr.dummy && !sym2->attr.optional)
{
- class_decl = DECL_LANG_SPECIFIC (sym2->backend_decl) ?
- GFC_DECL_SAVED_DESCRIPTOR (sym2->backend_decl) :
- sym2->backend_decl;
+ class_decl = sym2->backend_decl;
+ if (DECL_LANG_SPECIFIC (class_decl)
+ && GFC_DECL_SAVED_DESCRIPTOR (class_decl))
+ class_decl = GFC_DECL_SAVED_DESCRIPTOR (class_decl);
if (POINTER_TYPE_P (TREE_TYPE (class_decl)))
class_decl = build_fold_indirect_ref_loc (input_location,
class_decl);
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_18.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_18.f90
index a8fa3ff..0bc419a 100644
--- a/gcc/testsuite/gfortran.dg/assumed_rank_18.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_18.f90
@@ -7,7 +7,10 @@ program p
contains
subroutine g(x)
real :: x(..)
- call h(x)
+ select rank (x)
+ rank (1)
+ call h(x)
+ end select
end
subroutine h(x)
real :: x(*)
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_10.f90 b/gcc/testsuite/gfortran.dg/assumed_type_10.f90
index bf0c873..a8bbf2d 100644
--- a/gcc/testsuite/gfortran.dg/assumed_type_10.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_type_10.f90
@@ -31,7 +31,10 @@ contains
subroutine test_array (a)
use iso_c_binding, only: c_size_t
class(*), dimension(..), target :: a
- call test_lib (a, int (sizeof (a), kind=c_size_t))
+ select rank (a)
+ rank (1)
+ call test_lib (a, int (sizeof (a), kind=c_size_t))
+ end select
end subroutine
end module
diff --git a/gcc/testsuite/gfortran.dg/assumed_type_11.f90 b/gcc/testsuite/gfortran.dg/assumed_type_11.f90
index df6572d..391fa0d 100644
--- a/gcc/testsuite/gfortran.dg/assumed_type_11.f90
+++ b/gcc/testsuite/gfortran.dg/assumed_type_11.f90
@@ -31,7 +31,10 @@ contains
subroutine test_array (a)
use iso_c_binding, only: c_size_t
class(*), dimension(..), target :: a
- call test_lib (a, int (sizeof (a), kind=c_size_t))
+ select rank (a)
+ rank (1)
+ call test_lib (a, int (sizeof (a), kind=c_size_t))
+ end select
end subroutine
end module
