[Patch, fortran] PR27113 - character array constructors with subarray components

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This patch fixes PR27113, which is representative of the failure to be 
able to include array components into character array constructors. The 
PR testcase comes from tonto-2.2:

  subroutine complex_constructor

    type BASIS_TYPE
      character(len=512) :: label
    end type

    type(BASIS_TYPE), dimension(:), pointer :: var

    call read_library_data_((/var%label/))
  end subroutine complex_constructor

emits..

complex_constructor.f90: In function ‘complex_constructor’:
complex_constructor.f90:1: fatal error: gfc_todo: Not Implemented: complex
character array constructors
compilation terminated.


The fix turns out to be rather trivial. There is a typo, that inverted 
REF and COMPONENT, in REF_COMPONENT and a redundant gfc_todo_error that 
prevented a perfectly good bit of code from being used. The former 
produces the error message that is seen.

Regtested on FC3/Athlon. OK for trunk and 4.1?

Paul



2006-04-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/27113
	* trans-array.c (gfc_trans_array_constructor_subarray): Remove
	redundant gfc_todo_error.
	(get_array_ctor_var_strlen): Remove typo in enum.

2006-04-18  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/27113
	* gfortran.dg/character_array_constructor_1.f90: New test.

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 112981)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_trans_array_constructor_subarray (st
*** 1035,1043 ****
    gfc_copy_loopinfo_to_se (&se, &loop);
    se.ss = ss;
  
-   if (expr->ts.type == BT_CHARACTER)
-     gfc_todo_error ("character arrays in constructors");
- 
    gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr);
    gcc_assert (se.ss == gfc_ss_terminator);
  
--- 1035,1040 ----
*************** get_array_ctor_var_strlen (gfc_expr * ex
*** 1311,1317 ****
  	  /* Array references don't change the string length.  */
  	  break;
  
! 	case COMPONENT_REF:
  	  /* Use the length of the component.  */
  	  ts = &ref->u.c.component->ts;
  	  break;
--- 1308,1314 ----
  	  /* Array references don't change the string length.  */
  	  break;
  
! 	case REF_COMPONENT:
  	  /* Use the length of the component.  */
  	  ts = &ref->u.c.component->ts;
  	  break;
Index: gcc/testsuite/gfortran.dg/character_array_constructor_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/character_array_constructor_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/character_array_constructor_1.f90	(revision 0)
***************
*** 0 ****
--- 1,47 ----
+ ! { dg-do run }
+ ! Tests the fix for PR27113, in which character structure
+ ! components would produce the TODO compilation error "complex
+ ! character array constructors".
+ !
+ ! Test based on part of tonto-2.2;
+ ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
+ !
+   type BASIS_TYPE
+     character(len=8) :: label
+   end type
+ 
+   type(BASIS_TYPE), dimension(:), pointer :: ptr
+   character(8), dimension(2) :: carray
+ 
+   allocate (ptr(2))
+   ptr(1)%label = "Label 1"
+   ptr(2)%label = "Label 2"
+ 
+ ! This is the original bug
+   call read_library_data_((/ptr%label/))
+ 
+   carray(1) = "Label 3"
+   carray(2) = "Label 4"
+ 
+ ! Mix a character array with the character component of a derived type pointer array.
+   call read_library_data_((/carray, ptr%label/))
+ 
+ ! Finally, add a constant (character(8)).
+   call read_library_data_((/carray, ptr%label, "Label 5 "/))
+ 
+ contains
+ 
+   subroutine read_library_data_ (chr)
+     character(*), dimension(:) :: chr
+     character(len = len(chr)) :: tmp
+     if (size(chr,1) == 2) then
+       if (any (chr .ne. (/"Label 1", "Label 2"/))) call abort ()
+     elseif (size(chr,1) == 4) then
+       if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2"/))) call abort ()
+     elseif (size(chr,1) == 5) then
+       if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2", "Label 5"/))) &
+           call abort ()
+     end if
+   end subroutine read_library_data_
+ 
+ end