diff mbox series

[fortran] PR fortran/66833,67938,95214 ICE on using assumed rank character array

Message ID f8279154-f9bb-2dfb-33d9-af4815d10dc5@gmail.com
State New
Headers show
Series [fortran] PR fortran/66833,67938,95214 ICE on using assumed rank character array | expand

Commit Message

José Rui Faustino de Sousa May 19, 2020, 3:28 p.m. UTC 
Hi all!

Proposed patch to PRs 66833, 67938 and 95214 ICE(s) on using assumed 
rank character array in different situations.

Patch tested only on x86_64-pc-linux-gnu.

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

Thank you very much.

Best regards,
José Rui


2020-5-19  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

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

2020-5-19  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

  PR fortran/95214
  * PR95214.f90: New test.

Comments

Thomas Koenig June 3, 2020, 5:45 p.m. UTC | #1 
Hi Jose,

> Proposed patch to PRs 66833, 67938 and 95214 ICE(s) on using assumed 
> rank character array in different situations.

Reviewed and committed with some trival changes:

It is better not to use STOP codes > 255, so I just
counted them up.

Some changes to the ChangeLog: Mentioned all PRs there and made the
ChangeLog conform to the upload checker (well, it worked the second time
:-)

Here's what I committed as r11-879:

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

gcc/fortran/ChangeLog:

2020-05-19  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-05-19  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

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

Thanks a lot for the patch!  I notice you still have a couple
of submissions, I'll try to get to them in the next few
days (unless somebody else beats me to a review).

Best regards

	Thomas
diff mbox series

Patch

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..682ef63
--- /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 1001
+    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 2001 ! 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 3001
+    if(any(ubound(x)/=[n])) stop 3002
+  end subroutine s1
+  
+  ! example z1s.f90
+  subroutine s1s_a(x)
+    character :: x(..)
+    if(size(x)/=n) stop 4001
+  end subroutine s1s_a
+  
+  subroutine s1s_b(x)
+    character(77) :: x(..)
+    if(size(x)/=n) stop 5001
+  end subroutine s1s_b
+  
+  ! example z2.f90
+  subroutine s2(x)
+    character(1) :: x(..)
+    if(lbound(x, dim=1)/=1) stop 6001
+    if(ubound(x, dim=1)/=n) stop 6002
+    if(size(x, dim=1)/=n)   stop 6003
+  end subroutine s2
+  
+end program chr_p
+
+