Hi Jerry, hi all,
thank you for the review. Commited as r221897.
Regards,
Andre
On Thu, 02 Apr 2015 17:06:07 -0700
Jerry DeLisle <[email protected]> wrote:
> On 04/02/2015 03:28 AM, Andre Vehreschild wrote:
> > Ping!
> >
> > This should be in 5.1. Dominique and I feel like this patch is nearly
> > obvious.
> >
> > Regards,
> > Andre
> >
> > On Wed, 25 Mar 2015 14:35:54 +0100
> > Andre Vehreschild <[email protected]> wrote:
> >
> >> Hi all,
> >>
> >> please find attached a fix for the recently introduced regression when
> >> allocating arrays with an intrinsic function for source=. The patch
> >> addresses this issue by using gfc_conv_expr_descriptor () for intrinsic
> >> functions.
> >>
> >> Bootstraps and regtests ok on x86_64-linux-gnu/F20.
> >>
> >> Ok for trunk?
>
> Yes, ok for trunk.
>
> Thanks,
>
> Jerry
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 221896)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,9 @@
+2015-04-07 Andre Vehreschild <[email protected]>
+
+ PR fortran/65548
+ * trans-stmt.c (gfc_trans_allocate): For intrinsic functions
+ use conv_expr_descriptor() instead of conv_expr_reference().
+
2015-03-30 Jakub Jelinek <[email protected]>
PR fortran/65597
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 221896)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5049,12 +5049,17 @@
/* In all other cases evaluate the expr3 and create a
temporary. */
gfc_init_se (&se, NULL);
- gfc_conv_expr_reference (&se, code->expr3);
+ if (code->expr3->rank != 0
+ && code->expr3->expr_type == EXPR_FUNCTION
+ && code->expr3->value.function.isym)
+ gfc_conv_expr_descriptor (&se, code->expr3);
+ else
+ gfc_conv_expr_reference (&se, code->expr3);
if (code->expr3->ts.type == BT_CLASS)
gfc_conv_class_to_class (&se, code->expr3,
code->expr3->ts,
false, true,
- false,false);
+ false, false);
gfc_add_block_to_block (&block, &se.pre);
gfc_add_block_to_block (&post, &se.post);
/* Prevent aliasing, i.e., se.expr may be already a
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 221896)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,8 @@
+2015-04-07 Andre Vehreschild <[email protected]>
+
+ PR fortran/65548
+ * gfortran.dg/allocate_with_source_5.f90: New test.
+
2015-04-07 Ilya Enkovich <[email protected]>
* gcc.target/i386/mpx/chkp-thunk-comdat-1.cc: New.
Index: gcc/testsuite/gfortran.dg/allocate_with_source_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocate_with_source_5.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/allocate_with_source_5.f90 (Arbeitskopie)
@@ -0,0 +1,52 @@
+! { dg-do run }
+!
+! Check that pr65548 is fixed.
+! Contributed by Juergen Reuter <[email protected]>
+
+module allocate_with_source_5_module
+
+ type :: selector_t
+ integer, dimension(:), allocatable :: map
+ real, dimension(:), allocatable :: weight
+ contains
+ procedure :: init => selector_init
+ end type selector_t
+
+contains
+
+ subroutine selector_init (selector, weight)
+ class(selector_t), intent(out) :: selector
+ real, dimension(:), intent(in) :: weight
+ real :: s
+ integer :: n, i
+ logical, dimension(:), allocatable :: mask
+ s = sum (weight)
+ allocate (mask (size (weight)), source = weight /= 0)
+ n = count (mask)
+ if (n > 0) then
+ allocate (selector%map (n), &
+ source = pack ([(i, i = 1, size (weight))], mask))
+ allocate (selector%weight (n), &
+ source = pack (weight / s, mask))
+ else
+ allocate (selector%map (1), source = 1)
+ allocate (selector%weight (1), source = 0.)
+ end if
+ end subroutine selector_init
+
+end module allocate_with_source_5_module
+
+program allocate_with_source_5
+ use allocate_with_source_5_module
+
+ class(selector_t), allocatable :: sel;
+ real, dimension(5) :: w = [ 1, 0, 2, 0, 3];
+
+ allocate (sel)
+ call sel%init(w)
+
+ if (any(sel%map /= [ 1, 3, 5])) call abort()
+ if (any(abs(sel%weight - [1, 2, 3] / 6) < 1E-6)) call abort()
+end program allocate_with_source_5
+! { dg-final { cleanup-modules "allocate_with_source_5_module" } }
+
