From: Andre Vehreschild <vehre@gmx.de>
To: Steve Kargl <sgk@troutmask.apl.washington.edu>
Cc: GCC-Fortran-ML <fortran@gcc.gnu.org>,
GCC-Patches-ML <gcc-patches@gcc.gnu.org>
Subject: Re: PING! [Fortran, Patch, PR72832, v1] [6/7 Regression] [OOP] ALLOCATE with SOURCE fails to allocate requested dimensions
Date: Sun, 23 Oct 2016 11:57:00 -0000 [thread overview]
Message-ID: <20161023135701.6f3e5999@vepi2> (raw)
In-Reply-To: <20161013105259.689a4b60@vepi2>
[-- Attachment #1: Type: text/plain, Size: 724 bytes --]
Hi all,
due to no complains about the trunk version, backported to gcc-6 as r241448.
Regards,
Andre
On Thu, 13 Oct 2016 10:52:59 +0200
Andre Vehreschild <vehre@gmx.de> wrote:
> Hi Steve,
>
> thanks for the review. Committed as r241088 on trunk.
>
> Letting it mature for one week in trunk before backporting to gcc-6.
>
> Regards,
> Andre
>
> On Wed, 12 Oct 2016 10:18:29 -0700
> Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>
> > On Wed, Oct 12, 2016 at 11:50:10AM +0200, Andre Vehreschild wrote:
> > > Ping!
> > >
> > > Updated patch with the comments gotten so far.
> > >
> > > Ok for trunk?
> > >
> >
> > Looks good to me.
> >
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit_gcc6.diff --]
[-- Type: text/x-patch, Size: 7228 bytes --]
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 241447)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,14 @@
+2016-10-23 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ Backported from trunk
+ PR fortran/72832
+ * trans-expr.c (gfc_copy_class_to_class): Add generation of
+ runtime array bounds check.
+ * trans-intrinsic.c (gfc_conv_intrinsic_size): Add a crutch to
+ get the descriptor of a function returning a class object.
+ * trans-stmt.c (gfc_trans_allocate): Use the array spec on the
+ array to allocate instead of the array spec from source=.
+
2016-10-17 Steven G. Kargl <kargl@gcc.gnu.org>
Backport from trunk
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 241447)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -1166,6 +1166,7 @@
stmtblock_t body;
stmtblock_t ifbody;
gfc_loopinfo loop;
+ tree orig_nelems = nelems; /* Needed for bounds check. */
gfc_init_block (&body);
tmp = fold_build2_loc (input_location, MINUS_EXPR,
@@ -1193,6 +1194,31 @@
}
vec_safe_push (args, to_ref);
+ /* Add bounds check. */
+ if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) > 0 && is_from_desc)
+ {
+ char *msg;
+ const char *name = "<<unknown>>";
+ tree from_len;
+
+ if (DECL_P (to))
+ name = (const char *)(DECL_NAME (to)->identifier.id.str);
+
+ from_len = gfc_conv_descriptor_size (from_data, 1);
+ tmp = fold_build2_loc (input_location, NE_EXPR,
+ boolean_type_node, from_len, orig_nelems);
+ msg = xasprintf ("Array bound mismatch for dimension %d "
+ "of array '%s' (%%ld/%%ld)",
+ 1, name);
+
+ gfc_trans_runtime_check (true, false, tmp, &body,
+ &gfc_current_locus, msg,
+ fold_convert (long_integer_type_node, orig_nelems),
+ fold_convert (long_integer_type_node, from_len));
+
+ free (msg);
+ }
+
tmp = build_call_vec (fcn_type, fcn, args);
/* Build the body of the loop. */
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c (Revision 241447)
+++ gcc/fortran/trans-intrinsic.c (Arbeitskopie)
@@ -5815,9 +5815,20 @@
if (actual->expr->ts.type == BT_CLASS)
gfc_add_class_array_ref (actual->expr);
- argse.want_pointer = 1;
argse.data_not_needed = 1;
- gfc_conv_expr_descriptor (&argse, actual->expr);
+ if (gfc_is_alloc_class_array_function (actual->expr))
+ {
+ /* For functions that return a class array conv_expr_descriptor is not
+ able to get the descriptor right. Therefore this special case. */
+ gfc_conv_expr_reference (&argse, actual->expr);
+ argse.expr = gfc_build_addr_expr (NULL_TREE,
+ gfc_class_data_get (argse.expr));
+ }
+ else
+ {
+ argse.want_pointer = 1;
+ gfc_conv_expr_descriptor (&argse, actual->expr);
+ }
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
arg1 = gfc_evaluate_now (argse.expr, &se->pre);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 241447)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5476,7 +5476,8 @@
desc = tmp;
tmp = gfc_class_data_get (tmp);
}
- e3_is = E3_DESC;
+ if (code->ext.alloc.arr_spec_from_expr3)
+ e3_is = E3_DESC;
}
else
desc = !is_coarray ? se.expr
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 241447)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,11 @@
+2016-10-23 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ Backported from trunk
+ PR fortran/72832
+ * gfortran.dg/allocate_with_source_22.f03: New test.
+ * gfortran.dg/allocate_with_source_23.f03: New test. Expected to
+ fail.
+
2016-10-19 Uros Bizjak <ubizjak@gmail.com>
PR target/77991
Index: gcc/testsuite/gfortran.dg/allocate_with_source_22.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 (nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_22.f03 (Arbeitskopie)
@@ -0,0 +1,48 @@
+! { dg-do run }
+!
+! Test that pr72832 is fixed now.
+! Contributed by Daan van Vugt
+
+program allocate_source
+ type :: t
+ integer :: i
+ end type t
+ type, extends(t) :: tt
+ end type tt
+
+ call test_type()
+ call test_class()
+
+contains
+
+subroutine test_class()
+ class(t), allocatable, dimension(:) :: a, b
+ allocate(tt::a(1:2))
+ a(:)%i = [ 1,2 ]
+ if (size(a) /= 2) call abort()
+ if (any(a(:)%i /= [ 1,2])) call abort()
+
+ allocate(b(1:4), source=a)
+ ! b is incorrectly initialized here. This only is diagnosed when compiled
+ ! with -fcheck=bounds.
+ if (size(b) /= 4) call abort()
+ if (any(b(1:2)%i /= [ 1,2])) call abort()
+ select type (b(1))
+ class is (tt)
+ continue
+ class default
+ call abort()
+ end select
+end subroutine
+
+subroutine test_type()
+ type(t), allocatable, dimension(:) :: a, b
+ allocate(a(1:2))
+ if (size(a) /= 2) call abort()
+
+ allocate(b(1:4), source=a)
+ if (size(b) /= 4) call abort()
+end subroutine
+end program allocate_source
+
+
Index: gcc/testsuite/gfortran.dg/allocate_with_source_23.f03
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 (nicht existent)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_23.f03 (Arbeitskopie)
@@ -0,0 +1,67 @@
+! { dg-do run }
+! { dg-options "-fcheck=bounds" }
+! { dg-shouldfail "Array bounds mismatch" }
+!
+! Test that pr72832 is fixed now.
+! Contributed by Daan van Vugt
+
+program allocate_source
+ type :: t
+ integer :: i
+ end type t
+ type, extends(t) :: tt
+ end type tt
+
+ call test_type()
+ call test_class_correct()
+ call test_class_fail()
+
+contains
+
+subroutine test_class_correct()
+ class(t), allocatable, dimension(:) :: a, b
+ allocate(tt::a(1:2))
+ a(:)%i = [ 1,2 ]
+ if (size(a) /= 2) call abort()
+ if (any(a(:)%i /= [ 1,2])) call abort()
+
+ allocate(b(1:4), source=a(1))
+ if (size(b) /= 4) call abort()
+ if (any(b(:)%i /= [ 1,1,1,1])) call abort()
+ select type (b(1))
+ class is (tt)
+ continue
+ class default
+ call abort()
+ end select
+end subroutine
+
+subroutine test_class_fail()
+ class(t), allocatable, dimension(:) :: a, b
+ allocate(tt::a(1:2))
+ a(:)%i = [ 1,2 ]
+ if (size(a) /= 2) call abort()
+ if (any(a(:)%i /= [ 1,2])) call abort()
+
+ allocate(b(1:4), source=a) ! Fail expected: sizes do not conform
+ if (size(b) /= 4) call abort()
+ if (any(b(1:2)%i /= [ 1,2])) call abort()
+ select type (b(1))
+ class is (tt)
+ continue
+ class default
+ call abort()
+ end select
+end subroutine
+
+subroutine test_type()
+ type(t), allocatable, dimension(:) :: a, b
+ allocate(a(1:2))
+ if (size(a) /= 2) call abort()
+
+ allocate(b(1:4), source=a)
+ if (size(b) /= 4) call abort()
+end subroutine
+end program allocate_source
+
+
prev parent reply other threads:[~2016-10-23 11:57 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-09-02 7:59 Andre Vehreschild
2016-10-12 9:50 ` PING! " Andre Vehreschild
2016-10-12 17:18 ` Steve Kargl
2016-10-13 8:53 ` Andre Vehreschild
2016-10-23 11:57 ` Andre Vehreschild [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20161023135701.6f3e5999@vepi2 \
--to=vehre@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=sgk@troutmask.apl.washington.edu \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).