From: Sandra Loosemore <sandra@codesourcery.com>
Date: Mon, 20 Sep 2021 00:23:58 +0000 (-0700)
Subject: Fortran: Fix testcases that violate C838, + revealed ICE
X-Git-Tag: basepoints/gcc-13~4487
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8fa9e73e6db0ff05447f5547df925fdcb4733d05;p=thirdparty%2Fgcc.git

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 11df1863badf..a8ff473510f0 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 a8fa3ff78d91..0bc419ac6d7e 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 bf0c87320ca3..a8bbf2d343ea 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 df6572dd5b39..391fa0de8f22 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