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  <sandra@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 11df1863badfa7a22846b5992426aa583bdb1a98..a8ff473510f0015214c781b0a4dcac229a362011 100644 (file)
--- 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 a8fa3ff78d917e993a6a20035ff65eda337ea9f4..0bc419ac6d7e601400db3e8c8ee5fb5625ee4ed8 100644 (file)
--- 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 bf0c87320ca3dfa9b180cf684c671dfeaa1ca5e3..a8bbf2d343ea0fe3cbf4e206428b5a69b53309a1 100644 (file)
--- 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 df6572dd5b39082d98447ca0d91e8bc25aeef12f..391fa0de8f22284cba80a5d4e6467a9d16058e1a 100644 (file)
--- 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