From: Janus Weil <janus@gcc.gnu.org>
To: gfortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>
Subject: [Patch, Fortran] PR 55072: [4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type
Date: Sat, 15 Dec 2012 23:52:00 -0000 [thread overview]
Message-ID: <CAKwh3qhObc=Jzv3m1hVNnRMa9uKn_eESTuAgye2vH5S-3U5_6g@mail.gmail.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 622 bytes --]
Hi all,
here is a patch for a pretty bad wrong-code regression, which affects
all maintained releases of gfortran. For discussion see bugzilla.
Regtested on x86_64-unknown-linux-gnu. Ok for 4.6, 4.7 and trunk?
Cheers,
Janus
2012-12-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/55072
* trans-array.c (gfc_conv_array_parameter): No packing was done for
full arrays of derived type.
2012-12-15 Janus Weil <janus@gcc.gnu.org>
PR fortran/55072
* gfortran.dg/assumed_type_2.f90: Fix test case.
* gfortran.dg/internal_pack_13.f90: New test.
* gfortran.dg/internal_pack_14.f90: New test.
[-- Attachment #2: pr55072_v4.diff --]
[-- Type: application/octet-stream, Size: 2697 bytes --]
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (revision 194517)
+++ gcc/fortran/trans-array.c (working copy)
@@ -6995,20 +6995,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr *
this_array_result = false;
/* Passing address of the array if it is not pointer or assumed-shape. */
- if (full_array_var && g77 && !this_array_result)
+ if (full_array_var && g77 && !this_array_result
+ && sym->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS)
{
tmp = gfc_get_symbol_decl (sym);
if (sym->ts.type == BT_CHARACTER)
se->string_length = sym->ts.u.cl->backend_decl;
- if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
- {
- gfc_conv_expr_descriptor (se, expr);
- se->expr = gfc_conv_array_data (se->expr);
- return;
- }
-
if (!sym->attr.pointer
&& sym->as
&& sym->as->type != AS_ASSUMED_SHAPE
Index: gcc/testsuite/gfortran.dg/assumed_type_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/assumed_type_2.f90 (revision 194517)
+++ gcc/testsuite/gfortran.dg/assumed_type_2.f90 (working copy)
@@ -157,7 +157,7 @@ end
! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_alloc._data.data" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_scalar .\\(struct t1 .\\) array_class_t1_ptr._data.dat" 1 "original" } }a
-! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 2 "original" } }
+! { dg-final { scan-tree-dump-times "sub_array_assumed \\(D" 3 "original" } }
! { dg-final { scan-tree-dump-times " = _gfortran_internal_pack \\(&parm" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_array_assumed \\(&array_int\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(real\\(kind=4\\).0:. . restrict\\) array_real_alloc.data" 1 "original" } }
@@ -165,7 +165,6 @@ end
! { dg-final { scan-tree-dump-times "\\.data = \\(void .\\) &array_t1.0.;" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) parm" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t2.0:. . restrict\\) array_t2_alloc.data\\);" 1 "original" } }
-! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t3.0:. .\\) array_t3_ptr.data\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. . restrict\\) array_class_t1_alloc._data.data\\);" 1 "original" } }
! { dg-final { scan-tree-dump-times "sub_array_assumed \\(\\(struct t1.0:. .\\) array_class_t1_ptr._data.data\\);" 1 "original" } }
[-- Attachment #3: internal_pack_13.f90 --]
[-- Type: application/octet-stream, Size: 557 bytes --]
! { dg-do run }
!
! PR 55072: [4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
implicit none
type t
integer :: i
end type t
type(t), target :: tgt(4,4)
type(t), pointer :: p(:,:)
integer :: i,j,k
k = 1
do i = 1, 4
do j = 1, 4
tgt(i,j)%i = k
k = k+1
end do
end do
p => tgt(::2,::2)
print *,p%i
call bar(p)
contains
subroutine bar(x)
type(t) :: x(*)
print *,x(1:4)%i
if (any (x(1:4)%i /= [1, 9, 3, 11])) call abort()
end subroutine
end
[-- Attachment #4: internal_pack_14.f90 --]
[-- Type: application/octet-stream, Size: 606 bytes --]
! { dg-do run }
!
! PR 55072: [4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
program GiBUU_neutrino_bug
Type particle
integer :: ID
End Type
type(particle), dimension(1:2,1:2) :: OutPart
OutPart(1,:)%ID = 1
OutPart(2,:)%ID = 2
call s1(OutPart(1,:))
contains
subroutine s1(j)
type(particle) :: j(:)
print *,j(:)%ID
call s2(j)
end subroutine
subroutine s2(k)
type(particle) :: k(1:2)
print *,k(:)%ID
if (any (k(1:2)%ID /= [1, 1])) call abort()
end subroutine
end
next reply other threads:[~2012-12-15 23:52 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2012-12-15 23:52 Janus Weil [this message]
2012-12-16 11:40 ` Tobias Burnus
2012-12-16 13:03 ` Janus Weil
2013-01-10 19:39 ` Janus Weil
2013-01-11 17:19 ` Mikael Morin
2013-01-11 20:32 ` Janus Weil
2013-01-11 20:51 ` Mikael Morin
2013-01-11 22:25 ` Paul Richard Thomas
2013-01-12 19:01 ` Janus Weil
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='CAKwh3qhObc=Jzv3m1hVNnRMa9uKn_eESTuAgye2vH5S-3U5_6g@mail.gmail.com' \
--to=janus@gcc.gnu.org \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/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).