aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/trans-expr.c3
-rw-r--r--gcc/testsuite/gfortran.dg/PR95214.f9084
2 files changed, 86 insertions, 1 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 33fc061..435eaeb 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 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
+
+