This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch/gfortran] PR18109, 18283 & 19107


I think that I must be some kind of glutton for punishment! I take it from the latest exchanges that the injunction to commit at will for this kind of patch is withdrawn?

Anway, it's more of the same and will have to follow any corrections that we make to the previous patch. PRs 18109 and 19107 have already been seen on the list.

There are a number of similar problems that are not the subject of PRs. I will try to develop solutions to these and the other remaining character PRs whilst I am away.

2005-05-30 Paul Thomas <pault@gcc.gnu.org>

   PR fortran/18109
   PR fortran/18283
   PR fortran/19107
   * fortran/trans-array.c (gfc_conv_expr_descriptor): Obtain the
   string length from the expression typespec character length value
   and set temp_ss->stringlength and backend_decl. Obtain the
   tree expression from gfc_conv_expr rather than gfc_conv_expr_val.
   Dereference the expression to obtain the character.
   * fortran/trans-expr.c (gfc_conv_component_ref): Remove the
   dereference of scalar character pointer structure components.
   * fortran/trans-expr.c (gfc_trans_subarray_assign): Obtain the
   string length for the structure component from the component
   expression.


2005-05-30 Paul Thomas <pault@gcc.gnu.org>


   * gfortran.dg/char_initialiser_actual.f90:
   Test character initialisers as actual arguments.
   * gfortran.dg/char_pointer_comp_assign.f90:
   Test character pointer structure component assignments.
   * gfortran.dg/char_array_structure_constructor.f90:
   Test character components in structure constructors.

Bubblestrapped and regtested on i686/RH9. OK to commit to 4.1, at least?

Paul T



Index: trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.46
diff -c -3 -p -r1.46 trans-array.c
*** trans-array.c	29 May 2005 16:02:09 -0000	1.46
--- trans-array.c	30 May 2005 20:03:02 -0000
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 3616,3627 ****
        loop.temp_ss = gfc_get_ss ();
        loop.temp_ss->type = GFC_SS_TEMP;
        loop.temp_ss->next = gfc_ss_terminator;
!       loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
  
        /* ... which can hold our string, if present.  */
        if (expr->ts.type == BT_CHARACTER)
! 	se->string_length = loop.temp_ss->string_length
! 	  = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
        else
  	loop.temp_ss->string_length = NULL;
        loop.temp_ss->data.temp.dimen = loop.dimen;
--- 3616,3638 ----
        loop.temp_ss = gfc_get_ss ();
        loop.temp_ss->type = GFC_SS_TEMP;
        loop.temp_ss->next = gfc_ss_terminator;
!       if (expr->ts.type == BT_CHARACTER)
! 	{
! 	  gcc_assert (expr->ts.cl && expr->ts.cl->length
! 		      && expr->ts.cl->length->expr_type == EXPR_CONSTANT);
! 	  loop.temp_ss->string_length = gfc_conv_mpz_to_tree
! 			(expr->ts.cl->length->value.integer,
! 			 expr->ts.cl->length->ts.kind);
! 	  expr->ts.cl->backend_decl = loop.temp_ss->string_length;
! 	}
!         loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
  
        /* ... which can hold our string, if present.  */
        if (expr->ts.type == BT_CHARACTER)
! 	{
! 	  loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
! 	  se->string_length = loop.temp_ss->string_length;
! 	}
        else
  	loop.temp_ss->string_length = NULL;
        loop.temp_ss->data.temp.dimen = loop.dimen;
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 3653,3659 ****
        rse.ss = ss;
  
        gfc_conv_scalarized_array_ref (&lse, NULL);
!       gfc_conv_expr_val (&rse, expr);
  
        gfc_add_block_to_block (&block, &rse.pre);
        gfc_add_block_to_block (&block, &lse.pre);
--- 3664,3676 ----
        rse.ss = ss;
  
        gfc_conv_scalarized_array_ref (&lse, NULL);
!       if (expr->ts.type == BT_CHARACTER)
! 	{
! 	  gfc_conv_expr (&rse, expr);
! 	  rse.expr = gfc_build_indirect_ref (rse.expr);
! 	}
!       else
!         gfc_conv_expr_val (&rse, expr);
  
        gfc_add_block_to_block (&block, &rse.pre);
        gfc_add_block_to_block (&block, &lse.pre);
Index: trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.47
diff -c -3 -p -r1.47 trans-expr.c
*** trans-expr.c	30 May 2005 15:33:32 -0000	1.47
--- trans-expr.c	30 May 2005 20:03:05 -0000
*************** gfc_conv_component_ref (gfc_se * se, gfc
*** 281,287 ****
        se->string_length = tmp;
      }
  
!   if (c->pointer && c->dimension == 0)
      se->expr = gfc_build_indirect_ref (se->expr);
  }
  
--- 281,287 ----
        se->string_length = tmp;
      }
  
!   if (c->pointer && c->dimension == 0 && c->ts.type != BT_CHARACTER)
      se->expr = gfc_build_indirect_ref (se->expr);
  }
  
*************** gfc_trans_subarray_assign (tree dest, gf
*** 1671,1676 ****
--- 1671,1679 ----
    gfc_start_scalarized_body (&loop, &body);
  
    gfc_conv_tmp_array_ref (&lse);
+   if (cm->ts.type == BT_CHARACTER)
+     lse.string_length = cm->ts.cl->backend_decl;
+ 
    gfc_conv_expr (&rse, expr);
  
    tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts.type);
! { dg do-run }
! Tests passing of character array initialiser as actual argument.
! Fixes PR18109.
! Contributed by Paul Thomas pault@gcc.gnu.org  
program char_initialiser
  character*5, dimension(3) :: x
  character*5, dimension(:), pointer :: y
  x=(/"is Ja","ne Fo","nda"/)
  call sfoo ("is Ja", x(1))
  call afoo ((/"is Ja","ne Fo","nda"/), x)
  y => pfoo ((/"is Ja","ne Fo","nda"/))
  call afoo (y, x)
contains
  subroutine sfoo(ch1, ch2)
     character*(*)               :: ch1, ch2
     if (ch1 /= ch2) call abort ()
  end subroutine sfoo
  subroutine afoo(ch1, ch2)
     character*(*), dimension(:) :: ch1, ch2
     if (any(ch1 /= ch2)) call abort ()
  end subroutine afoo
  function pfoo(ch2)
     character*5, dimension(:), target  :: ch2
     character*5, dimension(:), pointer :: pfoo
     pfoo => ch2
  end function pfoo
end program
! { dg-do run }
! This test the fix of PR18283, where assignments of scalar,
! character pointer components of derived types caused an ICE.
! It also checks that the array counterparts remain operational.
! Contributed by Paul Thomas  pault@gcc.gnu.org
!
program char_pointer_comp_assign
  implicit none
  type :: dt
     character (len=4), pointer :: scalar
     character (len=4), pointer :: array(:)
  end type dt
  type (dt) :: a 
  character (len=4), target :: scalar_t ="abcd"
  character (len=4), target :: array_t(2) = (/"abcd","efgh"/)

! Do assignments first
  allocate (a%scalar, a%array(2))
  a%scalar = scalar_t
  if (a%scalar /= "abcd") call abort ()
  a%array = array_t
  if (any(a%array /= (/"abcd","efgh"/))) call abort ()
  deallocate (a%scalar, a%array)

! Now do pointer assignments.
  a%scalar => scalar_t
  if (a%scalar /= "abcd") call abort ()
  a%array => array_t
  if (any(a%array /= (/"abcd","efgh"/))) call abort ()

end program char_pointer_comp_assign
! { dg-do run }
! This test the fix of PR19107, where character array actual
! arguments in derived type constructors caused an ICE.
! It also checks that the scalar counterparts are OK.
! Contributed by Paul Thomas  pault@gcc.gnu.org
!
MODULE global
  TYPE :: dt
    CHARACTER(4) a
    CHARACTER(4) b(2)
  END TYPE
  TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
END MODULE global
program char_array_structure_constructor
  USE global
  call alloc (2)
  if ((any (c%a /= "wxyz")) .OR. &
      (any (c%b(1) /= "abcd")) .OR. &
      (any (c%b(2) /= "efgh"))) call abort ()
contains
  SUBROUTINE alloc (n)
    USE global
    ALLOCATE (c(n), STAT=IALLOC_FLAG)
    DO i = 1,n
      c (i) = dt ("wxyz",(/"abcd","efgh"/))
    ENDDO
  end subroutine alloc
END program char_array_structure_constructor

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]