[Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Paul Richard Thomas]

Dear All,

Spurred by a clf thread, I have made a start on deferred length
character bugs. The meta-bug  was posted by Dominique, for which
thanks.

The change to trans-array.c is done to ensure that gfc_build_array_ref
has the DECL_CONTEXT of the symbol to compare with that of the
deferred string length variable.

That is trans-stmt.c provides the deferred string length variable for
allocations, where an explicit typespec is used. This ensures that the
dtype of the allocated array descriptor has the correct size.

The trans-types.c and trans.c modifications are sufficiently described
in the ChangeLog below.

Boostraps and regtests on FC21/x86_64 - OK for trunk?

There seems to be some irritation out in the field that gfortran's
handling of deferred length characters is not in very good shape. The
attached patch will need some adaptation to work with 4.9 and 5
branches. However, I think that it is worthwhile to do this because
the distros will not include 6 branch for quite a long time. I will
submit the patch(es) for 4.9 and 5 separately.

Louis Krupp is looking at PR49954 (ICE assigning concat expression to
an array deferred-length string (realloc on assignment)), which is a
really unpleasant bug that winds up putting code using temporary
variables before their decalarations, thereby mightily upsetting the
gimplifier. By the way, Louis, The assignment should be generating a
temporary, I think. I do not see any sign of that in the code :-(

Cheers

Paul

2015-11-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/50221
    PR fortran/68216
    * trans_array.c (gfc_conv_scalarized_array_ref): Pass the
    symbol decl for deferred character length array references.
    * trans-stmt.c (gfc_trans_allocate): Keep the string lengths
    to update deferred length character string lengths.
    * trans-types.c (gfc_get_dtype_rank_type); Use the string
    length of deferred character types for the dtype size.
    * trans.c (gfc_build_array_ref): For references to deferred
    character arrays, use the domain max value, if it is a variable
    to set the 'span' and use pointer arithmetic for access to the
    element.
    (trans_code): Set gfc_current_locus for diagnostic purposes.

    PR fortran/67674
    * trans-expr.c (gfc_conv_procedure_call): Do not fix deferred
    string lengths of component references.

2015-11-09  Paul Thomas  <pault@gcc.gnu.org>

    PR fortran/50221
    * gfortran.dg/deferred_character_1.f90: New test.

    PR fortran/68216
    * gfortran.dg/deferred_character_2.f90: New test.

    PR fortran/67674
    * gfortran.dg/deferred_character_3.f90: New test.

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Steve Kargl]

On Mon, Nov 09, 2015 at 02:38:15PM +0100, Paul Richard Thomas wrote:
> 
> Boostraps and regtests on FC21/x86_64 - OK for trunk?
> 

Patch seems to have been left behind.

-- 
Steve

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 591 bytes --]

Dear Steve,

I was charging around like a mad thing yesterday and sent the
submission in something of a hurry. Thanks for pointing out the
omission so quickly.

Please find the patch attached.

Cheers

Paul

On 9 November 2015 at 15:46, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Mon, Nov 09, 2015 at 02:38:15PM +0100, Paul Richard Thomas wrote:
>>
>> Boostraps and regtests on FC21/x86_64 - OK for trunk?
>>
>
> Patch seems to have been left behind.
>
> --
> Steve



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 11144 bytes --]

Index: /svn/trunk/gcc/fortran/trans-array.c
===================================================================
*** /svn/trunk/gcc/fortran/trans-array.c	(revision 229953)
--- /svn/trunk/gcc/fortran/trans-array.c	(working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3168,3174 ****
      index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
  			     index, info->offset);

!   if (expr && is_subref_array (expr))
      decl = expr->symtree->n.sym->backend_decl;

    tmp = build_fold_indirect_ref_loc (input_location, info->data);
--- 3168,3175 ----
      index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
  			     index, info->offset);

!   if (expr && (is_subref_array (expr)
! 	       || expr->ts.deferred))
      decl = expr->symtree->n.sym->backend_decl;

    tmp = build_fold_indirect_ref_loc (input_location, info->data);
Index: /svn/trunk/gcc/fortran/trans-expr.c
===================================================================
*** /svn/trunk/gcc/fortran/trans-expr.c	(revision 229953)
--- /svn/trunk/gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 5601,5607 ****
  	  else
  	    {
  	      tmp = parmse.string_length;
! 	      if (TREE_CODE (tmp) != VAR_DECL)
  		tmp = gfc_evaluate_now (parmse.string_length, &se->pre);
  	      parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp);
  	    }
--- 5601,5608 ----
  	  else
  	    {
  	      tmp = parmse.string_length;
! 	      if (TREE_CODE (tmp) != VAR_DECL
! 		  && TREE_CODE (tmp) != COMPONENT_REF)
  		tmp = gfc_evaluate_now (parmse.string_length, &se->pre);
  	      parmse.string_length = gfc_build_addr_expr (NULL_TREE, tmp);
  	    }
Index: /svn/trunk/gcc/fortran/trans-stmt.c
===================================================================
*** /svn/trunk/gcc/fortran/trans-stmt.c	(revision 229953)
--- /svn/trunk/gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 5089,5094 ****
--- 5089,5095 ----
    tree label_finish;
    tree memsz;
    tree al_vptr, al_len;
+   tree def_str_len = NULL_TREE;
    /* If an expr3 is present, then store the tree for accessing its
       _vptr, and _len components in the variables, respectively.  The
       element size, i.e. _vptr%size, is stored in expr3_esize.  Any of
*************** gfc_trans_allocate (gfc_code * code)
*** 5466,5471 ****
--- 5467,5473 ----
  	  expr3_esize = fold_build2_loc (input_location, MULT_EXPR,
  					 TREE_TYPE (se_sz.expr),
  					 tmp, se_sz.expr);
+ 	  def_str_len = gfc_evaluate_now (se_sz.expr, &block);
  	}
      }

*************** gfc_trans_allocate (gfc_code * code)
*** 5517,5522 ****
--- 5519,5535 ----

        se.want_pointer = 1;
        se.descriptor_only = 1;
+
+       if (expr->ts.type == BT_CHARACTER
+ 	  && expr->ts.deferred
+ 	  && TREE_CODE (expr->ts.u.cl->backend_decl) == VAR_DECL
+ 	  && def_str_len != NULL_TREE)
+ 	{
+ 	  tmp = expr->ts.u.cl->backend_decl;
+ 	  gfc_add_modify (&block, tmp,
+ 			  fold_convert (TREE_TYPE (tmp), def_str_len));
+ 	}
+
        gfc_conv_expr (&se, expr);
        if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
  	/* se.string_length now stores the .string_length variable of expr
Index: /svn/trunk/gcc/fortran/trans-types.c
===================================================================
*** /svn/trunk/gcc/fortran/trans-types.c	(revision 229954)
--- /svn/trunk/gcc/fortran/trans-types.c	(working copy)
*************** gfc_get_dtype_rank_type (int rank, tree
*** 1455,1460 ****
--- 1455,1468 ----
      }

    gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
+
+   if (TREE_CODE (etype) == ARRAY_TYPE
+       && TYPE_MAXVAL (TYPE_DOMAIN (etype)) != NULL_TREE
+       && TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (etype))) == VAR_DECL
+       && DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (etype)))
+ 				== current_function_decl)
+     size = TYPE_MAXVAL (TYPE_DOMAIN (etype));
+   else
      size = TYPE_SIZE_UNIT (etype);

    i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
Index: /svn/trunk/gcc/fortran/trans.c
===================================================================
*** /svn/trunk/gcc/fortran/trans.c	(revision 229953)
--- /svn/trunk/gcc/fortran/trans.c	(working copy)
*************** gfc_build_array_ref (tree base, tree off
*** 334,339 ****
--- 334,351 ----

    type = TREE_TYPE (type);

+   /* Use pointer arithmetic for deferred character length array
+      references.  */
+   if (type && TREE_CODE (type) == ARRAY_TYPE
+       && TYPE_MAXVAL (TYPE_DOMAIN (type)) != NULL_TREE
+       && TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (type))) == VAR_DECL
+       && decl
+       && DECL_CONTEXT (TYPE_MAXVAL (TYPE_DOMAIN (type)))
+ 					== DECL_CONTEXT (decl))
+     span = TYPE_MAXVAL (TYPE_DOMAIN (type));
+   else
+     span = NULL_TREE;
+
    if (DECL_P (base))
      TREE_ADDRESSABLE (base) = 1;

*************** gfc_build_array_ref (tree base, tree off
*** 348,355 ****
  		|| TREE_CODE (decl) == PARM_DECL)
         && ((GFC_DECL_SUBREF_ARRAY_P (decl)
  	    && !integer_zerop (GFC_DECL_SPAN (decl)))
! 	   || GFC_DECL_CLASS (decl)))
!       || vptr)
      {
        if (decl)
  	{
--- 360,368 ----
  		|| TREE_CODE (decl) == PARM_DECL)
         && ((GFC_DECL_SUBREF_ARRAY_P (decl)
  	    && !integer_zerop (GFC_DECL_SPAN (decl)))
! 	   || GFC_DECL_CLASS (decl)
! 	   || span != NULL_TREE))
!       || vptr != NULL_TREE)
      {
        if (decl)
  	{
*************** gfc_build_array_ref (tree base, tree off
*** 379,384 ****
--- 392,399 ----
  	    }
  	  else if (GFC_DECL_SUBREF_ARRAY_P (decl))
  	    span = GFC_DECL_SPAN (decl);
+ 	  else if (span)
+ 	    span = fold_convert (gfc_array_index_type, span);
  	  else
  	    gcc_unreachable ();
  	}
*************** trans_code (gfc_code * code, tree cond)
*** 1623,1628 ****
--- 1638,1644 ----
  	  gfc_add_expr_to_block (&block, res);
  	}

+       gfc_current_locus = code->loc;
        gfc_set_backend_locus (&code->loc);

        switch (code->op)
Index: /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_1.f90
===================================================================
*** /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_1.f90	(revision 0)
--- /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_1.f90	(working copy)
***************
*** 0 ****
--- 1,40 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR50221
+ !
+ ! Contributed by Clive Page  <clivegpage@gmail.com>
+ !            and Tobias Burnus  <burnus@gcc.gnu.org>
+ !
+ ! This is from comment #2 by Tobias Burnus.
+ !
+ module m
+   character(len=:), save, allocatable :: str(:)
+   character(len=2), parameter :: const(3) = ["a1", "b2", "c3"]
+ end
+
+   use m
+   call test()
+   if(allocated(str)) deallocate(str)
+   call foo
+ contains
+   subroutine test()
+     call doit()
+ !    print *, 'strlen=',len(str),' / array size =',size(str)
+ !    print '(3a)', '>',str(1),'<'
+ !    print '(3a)', '>',str(2),'<'
+ !    print '(3a)', '>',str(3),'<'
+     if (any (str .ne. const)) call abort
+   end subroutine test
+   subroutine doit()
+     str = const
+   end subroutine doit
+   subroutine foo
+ !
+ ! This is the original PR from Clive Page
+ !
+     character(:), allocatable, dimension(:) :: array
+     array = (/'xx', 'yy', 'zz'/)
+ !    print *, 'array=', array, len(array(1)), size(array)
+     if (any (array .ne. ["xx", "yy", "zz"])) call abort
+   end subroutine
+ end
Index: /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_2.f90
===================================================================
*** /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_2.f90	(revision 0)
--- /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_2.f90	(working copy)
***************
*** 0 ****
--- 1,58 ----
+ ! { dg-do run }
+ !
+ ! Tests the fix for PR68216
+ !
+ ! Reported on clf: https://groups.google.com/forum/#!topic/comp.lang.fortran/eWQTKfqKLZc
+ !
+ PROGRAM hello
+ !
+ ! This is the first testcase from Francisco (Ayyy LMAO)
+ !
+     IMPLICIT NONE
+
+     CHARACTER(LEN=:),DIMENSION(:),ALLOCATABLE :: array_lineas
+     character (3), dimension (2) :: src = ["abc","def"]
+     character (100) :: buffer
+     INTEGER :: largo , cant_lineas , i
+
+     write (buffer, "(2a3)") src
+
+ !    WRITE(*,*) ' Escriba un numero para el largo de cada linea'
+ !    READ(*,*) largo
+     largo = LEN (src)
+
+ !    WRITE(*,*) ' Escriba la cantidad de lineas'
+ !    READ(*,*) cant_lineas
+     cant_lineas = size (src, 1)
+
+     ALLOCATE(CHARACTER(LEN=largo) :: array_lineas(cant_lineas))
+
+ !    WRITE(*,*) 'Escriba el array', len(array_lineas), size(array_lineas)
+     READ(buffer,"(2a3)") (array_lineas(i),i=1,cant_lineas)
+
+ !    WRITE(*,*) 'Array guardado: '
+ !    DO i=1,cant_lineas
+ !    WRITE(*,*) array_lineas(i)
+ !    ENDDO
+      if (any (array_lineas .ne. src)) call abort
+ !    READ(*,*)
+      call testdefchar
+ contains
+      subroutine testdefchar
+ !
+ ! This is the testcase in the above thread from Blokbuster
+ !
+           implicit none
+           character(:), allocatable :: test(:)
+
+           allocate(character(3) :: test(2))
+           test(1) = 'abc'
+           test(2) = 'def'
+           if (any (test .ne. ['abc', 'def'])) call abort
+
+           test = ['aa','bb','cc']
+           if (any (test .ne. ['aa', 'bb', 'cc'])) call abort
+
+      end subroutine testdefchar
+
+ END PROGRAM
Index: /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_3.f90
===================================================================
*** /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_3.f90	(revision 0)
--- /svn/trunk/gcc/testsuite/gfortran.dg/deferred_character_3.f90	(working copy)
***************
*** 0 ****
--- 1,46 ----
+ ! {dg_do run }
+ !
+ ! Tests the fix for PR67674
+ !
+ ! Contributed by Kristopher Kuhlman  <kristopher.kuhlman@gmail.com>
+ !
+ program test
+   implicit none
+
+   type string_type
+     character(len=:), allocatable :: name
+   end type string_type
+   type(string_type), allocatable :: my_string_type
+
+   allocate(my_string_type)
+   allocate(character(len=0) :: my_string_type%name)
+
+ !  print *, 'length main program before',len(my_string_type%name)
+
+   call inputreadword1(my_string_type%name)
+
+ !  print *, 'length main program after',len(my_string_type%name)
+ !  print *, 'final result:',my_string_type%name
+   if (my_string_type%name .ne. 'here the word is finally set') call abort
+
+ contains
+   subroutine inputreadword1(word_intermediate)
+     character(len=:), allocatable :: word_intermediate
+
+ !    print *, 'length intermediate before',len(word_intermediate)
+     call inputreadword2(word_intermediate)
+ !    print *, 'length intermediate after',len(word_intermediate)
+ !    print *, word_intermediate
+
+   end subroutine inputreadword1
+
+   subroutine inputreadword2(word)
+     character(len=:), allocatable :: word
+
+ !    print *, 'length inner before',len(word)
+     word = 'here the word is finally set' ! want automatic reallocation to happen here
+ !    print *, 'length inner after',len(word)
+ !    print *, word
+
+   end subroutine inputreadword2
+ end program test

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Dominique d'Humières]

Dear Paul,

The patch for gcc/fortran/trans-types.c does not apply on revision r230071 and I had to use

--- ../_clean/gcc/fortran/trans-types.c	2015-11-08 18:04:13.000000000 +0100
+++ gcc/fortran/trans-types.c	2015-11-10 11:57:33.000000000 +0100
@@ -1455,7 +1455,13 @@ gfc_get_dtype_rank_type (int rank, tree 
     }
 
   gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
-  size = TYPE_SIZE_UNIT (etype);
+ 
+  if (TREE_CODE (etype) == ARRAY_TYPE
+      && TYPE_MAXVAL (TYPE_DOMAIN (etype)) != NULL_TREE
+      && TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (etype))) == VAR_DECL)
+    size = TYPE_MAXVAL (TYPE_DOMAIN (etype));
+  else
+    size = TYPE_SIZE_UNIT (etype);
 
   i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
   if (size && INTEGER_CST_P (size))

which I hope is correct.

With the patch (and a few others!-) I have regstrapped without any regression. The tests in pr50221 are fixed except the one in comment 4, the output is
           4           4
A   
CDV 
?


 I have also found that pr63932 and pr66408 are fixed by the patch.

Thanks for your work on this issue,

Dominique

> Le 10 nov. 2015 à 10:48, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> Dear Steve,
> 
> I was charging around like a mad thing yesterday and sent the
> submission in something of a hurry. Thanks for pointing out the
> omission so quickly.
> 
> Please find the patch attached.
> 
> Cheers
> 
> Paul
> 

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 2284 bytes --]

Hi Dominique,

Are you sure about pr50221 #4? It runs fine for me.

I have attached the testcases for PRs 50221#4, 63932, and 66408. I
propose to add these to the commit, once I get approval.....

I have a further patch for pr49954, which nearly fixes the testcase in
the PR but is not quite there. However, concatenation is in general
fixed, when there is no dependency. When there is, the lhs string
lengt gets updated before the concatenation, thereby shifting the op2
part of the concatenation. It'll be another few days....

Cheers

Paul



On 10 November 2015 at 16:39, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> Dear Paul,
>
> The patch for gcc/fortran/trans-types.c does not apply on revision r230071 and I had to use
>
> --- ../_clean/gcc/fortran/trans-types.c 2015-11-08 18:04:13.000000000 +0100
> +++ gcc/fortran/trans-types.c   2015-11-10 11:57:33.000000000 +0100
> @@ -1455,7 +1455,13 @@ gfc_get_dtype_rank_type (int rank, tree
>      }
>
>    gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
> -  size = TYPE_SIZE_UNIT (etype);
> +
> +  if (TREE_CODE (etype) == ARRAY_TYPE
> +      && TYPE_MAXVAL (TYPE_DOMAIN (etype)) != NULL_TREE
> +      && TREE_CODE (TYPE_MAXVAL (TYPE_DOMAIN (etype))) == VAR_DECL)
> +    size = TYPE_MAXVAL (TYPE_DOMAIN (etype));
> +  else
> +    size = TYPE_SIZE_UNIT (etype);
>
>    i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
>    if (size && INTEGER_CST_P (size))
>
> which I hope is correct.
>
> With the patch (and a few others!-) I have regstrapped without any regression. The tests in pr50221 are fixed except the one in comment 4, the output is
>            4           4
> A
> CDV
> ?
>
>
>  I have also found that pr63932 and pr66408 are fixed by the patch.
>
> Thanks for your work on this issue,
>
> Dominique
>
>> Le 10 nov. 2015 à 10:48, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
>>
>> Dear Steve,
>>
>> I was charging around like a mad thing yesterday and sent the
>> submission in something of a hurry. Thanks for pointing out the
>> omission so quickly.
>>
>> Please find the patch attached.
>>
>> Cheers
>>
>> Paul
>>
>



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

[-- Attachment #2: deferred_character_4.f90 --]
[-- Type: text/x-fortran, Size: 779 bytes --]

! { dg-do run }
!
! Check that PR50221 comment #4 is fixed.
!
! Contributed by Arjen Makus  <arjen.markus895@gmail.com>
!
program chk_alloc_string
    implicit none

    character(len=:), dimension(:), allocatable :: strings
    integer :: i

    allocate( character(10):: strings(1:3) )

    strings = [ "A   ", "C   ", "ABCD", "V   " ]

    if (len(strings) .ne. 4) call abort
    if (size(strings, 1) .ne. 4) call abort
    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V"])) call abort

    strings = [character(len=4) :: "A", "C", "ABCDE", "V", "zzzz"]

    if (len(strings) .ne. 4) call abort
    if (size(strings, 1) .ne. 5) call abort
    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V", "zzzz"])) call abort
end program chk_alloc_string

[-- Attachment #3: deferred_character_5.f90 --]
[-- Type: text/x-fortran, Size: 651 bytes --]

! { dg-do run }
!
! Tests that PR63932 stays fixed.
!
! Contributed by Valery Weber  <valeryweber@hotmail.com>
!
module mod
  type :: t
     character(:), allocatable :: c
     integer :: i
   contains
     procedure, pass :: get
  end type t
  type :: u
     character(:), allocatable :: c
  end type u
contains
  subroutine get(this, a)
    class(t), intent(in) :: this
    character(:), allocatable, intent(out), optional :: a
    if (present (a)) a = this%c
  end subroutine get
end module mod

program test
  use mod
  type(t) :: a
  type(u) :: b
  a%c = 'something'
  call a%get (a = b%c)
  if (b%c .ne. 'something') call abort
end program test

[-- Attachment #4: deferred_character_6.f90 --]
[-- Type: text/x-fortran, Size: 1137 bytes --]

! { dg-do run }
!
! Tests that PR66408 stays fixed.
!
! Contributed by <werner.blokbuster@gmail.com>
!
module mytest

    implicit none

    type vary
        character(:), allocatable :: string
    end type vary

    interface assignment(=)
        module procedure char_eq_vary
    end interface assignment(=)

contains

    subroutine char_eq_vary(my_char,my_vary)
        character(:), allocatable, intent(out) :: my_char
        type(vary), intent(in) :: my_vary
        my_char = my_vary%string
    end subroutine char_eq_vary

end module mytest


program thistest

    use mytest, only: vary, assignment(=)
    implicit none

    character(:), allocatable :: test_char
    character(14), parameter :: str = 'example string'
    type(vary) :: test_vary
    type(vary) :: my_stuff


    test_vary%string = str
    if (test_vary%string .ne. str) call abort

! This previously gave a blank string.
    my_stuff%string = test_vary
    if (my_stuff%string .ne. str) call abort

    test_char = test_vary
    if (test_char .ne. str) call abort

    my_stuff = test_vary
    if (my_stuff%string .ne. str) call abort

end program thistest

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Dominique d'Humières]

Paul,

Quick test: your attached tests works with a manual checking. However if I do the following changes in deferred_character_4.f90

--- /opt/gcc/work/gcc/testsuite/gfortran.dg/deferred_character_4.f90	2015-11-12 19:49:04.000000000 +0100
+++ deferred_character_4_db.f90	2015-11-12 19:52:08.000000000 +0100
@@ -18,9 +18,11 @@ program chk_alloc_string
     if (size(strings, 1) .ne. 4) call abort
     if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V"])) call abort
 
-    strings = [character(len=4) :: "A", "C", "ABCDE", "V", "zzzz"]
+!    strings = [character(len=4) :: "A", "C", "ABCDE", "V", "zzzz"]
+    strings = [character(len=4) :: "A", "C", "ABCDE", "V"]
 
     if (len(strings) .ne. 4) call abort
     if (size(strings, 1) .ne. 5) call abort
-    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V", "zzzz"])) call abort
+!    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V", "zzzz"])) call abort
+    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V"])) call abort
 end program chk_alloc_string

the program aborts.

Dominique

> Le 12 nov. 2015 à 14:14, Paul Richard Thomas <paul.richard.thomas@gmail.com> a écrit :
> 
> Hi Dominique,
> 
> Are you sure about pr50221 #4? It runs fine for me.
> 
> I have attached the testcases for PRs 50221#4, 63932, and 66408. I
> propose to add these to the commit, once I get approval.....
> 
> I have a further patch for pr49954, which nearly fixes the testcase in
> the PR but is not quite there. However, concatenation is in general
> fixed, when there is no dependency. When there is, the lhs string
> lengt gets updated before the concatenation, thereby shifting the op2
> part of the concatenation. It'll be another few days....
> 
> Cheers
> 
> Paul

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Dominique d'Humières]

Dear Paul,

Indeed the abort is due to the fact that I did not update the line

    if (size(strings, 1) .ne. 5) call abort

If I do, I dont get any abort. However with the updated patch

--- /opt/gcc/work/gcc/testsuite/gfortran.dg/deferred_character_4.f90	2015-11-12 19:49:04.000000000 +0100
+++ deferred_character_4_db.f90	2015-11-13 15:10:51.000000000 +0100
@@ -18,9 +18,14 @@ program chk_alloc_string
     if (size(strings, 1) .ne. 4) call abort
     if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V"])) call abort
 
-    strings = [character(len=4) :: "A", "C", "ABCDE", "V", "zzzz"]
+!    strings = [character(len=4) :: "A", "C", "ABCDE", "V", "zzzz"]
+    strings = [character(len=4) :: "A", "C", "ABCDE", "V"]
 
+    print *, len(strings), size(strings, 1)
+    print *, strings
     if (len(strings) .ne. 4) call abort
-    if (size(strings, 1) .ne. 5) call abort
-    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V", "zzzz"])) call abort
+!    if (size(strings, 1) .ne. 5) call abort
+    if (size(strings, 1) .ne. 4) call abort
+!    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V", "zzzz"])) call abort
+    if (any (strings .ne. [character(len=4) :: "A", "C", "ABCD", "V"])) call abort
 end program chk_alloc_string

the result of "print *, strings" is

 A   CDV ?

Dominique

> Le 12 nov. 2015 à 19:56, Dominique d'Humières <dominiq@lps.ens.fr> a écrit :
> 
> /opt/gcc/work/gcc/testsuite/gfortran.dg/deferred_character_4.f90

Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674

[Dominique d'Humières]

    do i = 1, size(strings, 1)
      print *, "'",strings(i),"'"
    end do

gives

 'A   '
 'C   '
 'ABCD'
 'V   ‘

print *, (strings(i), i= 1, size(strings, 1))

gives

"A   C   ABCDV   "   (double quotes added)

Both outputs seem correct, but

print *, strings

gives

" A   CDV ? »

and

print '(a)', strings

gives

A   
CDV 
?

i.e., four lines, the three last ones being wrong.

Dominique

> Le 13 nov. 2015 à 15:16, Dominique d'Humières <dominiq@lps.ens.fr> a écrit :
> 
> deferred_character_4_db.f90