[Bug fortran/27096] Automatic charlen pointer array result produces and ICE

[paul dot richard dot thomas at cea dot fr]

------- Comment #3 from paul dot richard dot thomas at cea dot fr  2006-04-10 
14:48 -------
A patch (not regtested yet, nor tested on tonto) and testcase for this and
PR25597:

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c    (révision 112529)
+++ gcc/fortran/trans-decl.c    (copie de travail)
@@ -2536,6 +2536,12 @@
        {
          tree result = TREE_VALUE (current_fake_result_decl);
          fnbody = gfc_trans_dummy_array_bias (proc_sym, result, fnbody);
+
+         /* An automatic character length, pointer array result.  */
+         if (proc_sym->ts.type == BT_CHARACTER
+               && TREE_CODE (proc_sym->ts.cl->backend_decl) == VAR_DECL)
+           fnbody = gfc_trans_dummy_character (proc_sym, proc_sym->ts.cl,
+                                               fnbody);
        }
       else if (proc_sym->ts.type == BT_CHARACTER)
        {
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c   (révision 112529)
+++ gcc/fortran/trans-array.c   (copie de travail)
@@ -4385,7 +4385,14 @@

   /* Get the descriptor type.  */
   type = TREE_TYPE (sym->backend_decl);
-  gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+  if (!GFC_DESCRIPTOR_TYPE_P (type))
+    {
+      /* If the backend_decl is not a descriptor, we must have a pointer
+        to one.  */
+      descriptor = build_fold_indirect_ref (sym->backend_decl);
+      type = TREE_TYPE (descriptor);
+      gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+    }

   /* NULLIFY the data pointer.  */
   gfc_conv_descriptor_data_set (&fnblock, descriptor, null_pointer_node);


! { dg-do run }
! Tests the fixes for PR25597 and PR27096.
!
! This test combines the PR testcases.
!
  character(10), dimension (2) :: implicit_result
  character(10), dimension (2) :: explicit_result
  character(10), dimension (2) :: source
  source = "abcdefghij"
  explicit_result = join_1(source)
  if (any (explicit_result .ne. source)) call abort () 

  implicit_result = reallocate_hnv (source, size(source, 1), LEN (source))
  if (any (implicit_result .ne. source)) call abort () 

contains

! This function would cause an ICE in gfc_trans_deferred_array.
  function join_1(self) result(res)
    character(len=*), dimension(:) :: self
    character(len=len(self)), dimension(:), pointer :: res
    allocate (res(2))
    res = self
  end function

! This function originally ICEd and latterly caused a runtime error.
  FUNCTION reallocate_hnv(p, n, LEN)
    CHARACTER(LEN=LEN), DIMENSION(:), POINTER :: reallocate_hnv
    character(*), dimension(:) :: p
    ALLOCATE (reallocate_hnv(n))
    reallocate_hnv = p
  END FUNCTION reallocate_hnv

end


Paul


-- 


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=27096