* [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
@ 2015-11-09 13:38 Paul Richard Thomas
2015-11-09 14:46 ` Steve Kargl
0 siblings, 1 reply; 8+ messages in thread
From: Paul Richard Thomas @ 2015-11-09 13:38 UTC (permalink / raw)
To: fortran; +Cc: Dominique Dhumieres, Damian Rouson, Louis Krupp
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.
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-09 13:38 [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674 Paul Richard Thomas
@ 2015-11-09 14:46 ` Steve Kargl
2015-11-10 9:48 ` Paul Richard Thomas
0 siblings, 1 reply; 8+ messages in thread
From: Steve Kargl @ 2015-11-09 14:46 UTC (permalink / raw)
To: Paul Richard Thomas
Cc: fortran, Dominique Dhumieres, Damian Rouson, Louis Krupp
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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-09 14:46 ` Steve Kargl
@ 2015-11-10 9:48 ` Paul Richard Thomas
2015-11-10 15:39 ` Dominique d'Humières
0 siblings, 1 reply; 8+ messages in thread
From: Paul Richard Thomas @ 2015-11-10 9:48 UTC (permalink / raw)
To: Steve Kargl; +Cc: fortran, Dominique Dhumieres, Damian Rouson, Louis Krupp
[-- 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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-10 9:48 ` Paul Richard Thomas
@ 2015-11-10 15:39 ` Dominique d'Humières
2015-11-12 13:14 ` Paul Richard Thomas
0 siblings, 1 reply; 8+ messages in thread
From: Dominique d'Humières @ 2015-11-10 15:39 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Steve Kargl, fortran, Damian Rouson, Louis Krupp
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
>
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-10 15:39 ` Dominique d'Humières
@ 2015-11-12 13:14 ` Paul Richard Thomas
2015-11-12 18:56 ` Dominique d'Humières
0 siblings, 1 reply; 8+ messages in thread
From: Paul Richard Thomas @ 2015-11-12 13:14 UTC (permalink / raw)
To: Dominique d'Humières
Cc: Steve Kargl, fortran, Damian Rouson, Louis Krupp
[-- 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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-12 13:14 ` Paul Richard Thomas
@ 2015-11-12 18:56 ` Dominique d'Humières
2015-11-13 14:16 ` Dominique d'Humières
0 siblings, 1 reply; 8+ messages in thread
From: Dominique d'Humières @ 2015-11-12 18:56 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Steve Kargl, fortran, Damian Rouson, Louis Krupp
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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-12 18:56 ` Dominique d'Humières
@ 2015-11-13 14:16 ` Dominique d'Humières
2015-11-13 15:32 ` Dominique d'Humières
0 siblings, 1 reply; 8+ messages in thread
From: Dominique d'Humières @ 2015-11-13 14:16 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Steve Kargl, fortran, Damian Rouson, Louis Krupp
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
^ permalink raw reply [flat|nested] 8+ messages in thread
* Re: [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674
2015-11-13 14:16 ` Dominique d'Humières
@ 2015-11-13 15:32 ` Dominique d'Humières
0 siblings, 0 replies; 8+ messages in thread
From: Dominique d'Humières @ 2015-11-13 15:32 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: Steve Kargl, fortran, Damian Rouson, Louis Krupp
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
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2015-11-13 15:32 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-11-09 13:38 [Patch, fortran] Bug 68241 - [meta-bug] Deferred-length character - PRs50221, 68216 and 67674 Paul Richard Thomas
2015-11-09 14:46 ` Steve Kargl
2015-11-10 9:48 ` Paul Richard Thomas
2015-11-10 15:39 ` Dominique d'Humières
2015-11-12 13:14 ` Paul Richard Thomas
2015-11-12 18:56 ` Dominique d'Humières
2015-11-13 14:16 ` Dominique d'Humières
2015-11-13 15:32 ` Dominique d'Humières
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).