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 33fc061d89b8eb9cd712d1597d265ffcd0ada1d5..435eaeb2c992dc605fc976692fd28979506518e4 100644 (file)
--- 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 (file)
index 0000000..8224767
--- /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
+
+