From: José Rui Faustino de Sousa <jrfsousa@gmail.com>
Date: Wed, 3 Jun 2020 17:33:11 +0000 (+0200)
Subject: Simple patch only add assumed-rank to the list of possible attributes.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8d57c30611b05a89fd265f6c0a74fe829c21cd34;p=gcc.git

Simple patch only add assumed-rank to the list of possible attributes.

gcc/fortran/ChangeLog:

2020-06-03  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

	PR fortran/95214
	PR fortran/66833
	PR fortran/67938
	* trans-expr.c (gfc_maybe_dereference_var): Add assumed-rank to
	character dummy arguments list of possible attributes.

gcc/testsuite/ChangeLog:

2020-06-03  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

	PR fortran/95214
	PR fortran/66833
	PR fortran/67938
	* gfortran.dg/PR95214.f90: New test.
---

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 33fc061d89b..435eaeb2c99 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2613,7 +2613,8 @@ gfc_maybe_dereference_var (gfc_symbol *sym, tree var, bool descriptor_only_p,
     {
       /* Dereference character pointer dummy arguments
 	 or results.  */
-      if ((sym->attr.pointer || sym->attr.allocatable)
+      if ((sym->attr.pointer || sym->attr.allocatable
+	   || (sym->as && sym->as->type == AS_ASSUMED_RANK))
 	  && (sym->attr.dummy
 	      || sym->attr.function
 	      || sym->attr.result))
diff --git a/gcc/testsuite/gfortran.dg/PR95214.f90 b/gcc/testsuite/gfortran.dg/PR95214.f90
new file mode 100644
index 00000000000..8224767cb67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/PR95214.f90
@@ -0,0 +1,84 @@
+! { dg-do run }
+!
+! PR fortran/95214
+!
+
+program chr_p
+
+  implicit none
+
+  integer, parameter :: u = 65
+  
+  integer, parameter :: n = 26
+  
+  character :: c(n)
+  integer   :: i
+
+  c = [(achar(i), i=u,u+n-1)]
+  call chr_s(c, c)
+  call gfc_descriptor_c_char(c)
+  call s1(c)
+  call s1s_a(c)
+  call s1s_b(c)
+  call s2(c)
+  stop
+  
+contains
+
+  subroutine chr_s(a, b)
+    character, intent(in) :: a(..)
+    character, intent(in) :: b(:)
+
+    integer :: i
+
+    select rank(a)
+    rank(1)
+      do i = 1, size(a)
+        if(a(i)/=b(i)) stop 1
+      end do
+    rank default
+      stop 2
+    end select
+    return
+  end subroutine chr_s
+
+  ! From Bug 66833
+  ! Contributed by Damian Rouson <damian@sourceryinstitute.org>
+  subroutine gfc_descriptor_c_char(a)
+    character a(..)
+    if(rank(a)/=1) stop 3 ! ICE (also for lbound, ubound, and c_loc)
+  end subroutine gfc_descriptor_c_char
+
+
+  ! From Bug 67938
+  ! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran@t-online.de>
+  
+  ! example z1.f90
+  subroutine s1(x)
+    character(1) :: x(..)
+    if(any(lbound(x)/=[1])) stop 4
+    if(any(ubound(x)/=[n])) stop 5
+  end subroutine s1
+  
+  ! example z1s.f90
+  subroutine s1s_a(x)
+    character :: x(..)
+    if(size(x)/=n) stop 6
+  end subroutine s1s_a
+  
+  subroutine s1s_b(x)
+    character(77) :: x(..)
+    if(size(x)/=n) stop 7
+  end subroutine s1s_b
+  
+  ! example z2.f90
+  subroutine s2(x)
+    character(1) :: x(..)
+    if(lbound(x, dim=1)/=1) stop 8
+    if(ubound(x, dim=1)/=n) stop 9
+    if(size(x, dim=1)/=n)   stop 10
+  end subroutine s2
+  
+end program chr_p
+
+