* [Patch, fortran, pr65548, v1] [5 Regression] gfc_conv_procedure_call
[not found] ` <bug-65548-26035-vcFxaNSRns@http.gcc.gnu.org/bugzilla/>
@ 2015-03-25 13:36 ` Andre Vehreschild
0 siblings, 0 replies; 2+ messages in thread
From: Andre Vehreschild @ 2015-03-25 13:36 UTC (permalink / raw)
To: GCC-Patches-ML, GCC-Fortran-ML; +Cc: dominiq at lps dot ens.fr
[-- Attachment #1: Type: text/plain, Size: 368 bytes --]
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?
Regards,
Andre
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: pr65548_1.clog --]
[-- Type: application/octet-stream, Size: 324 bytes --]
gcc/testsuite/ChangeLog:
2015-03-25 Andre Vehreschild <vehre@gmx.de>
* gfortran.dg/allocate_with_source_5.f90: New test.
gcc/fortran/ChangeLog:
2015-03-25 Andre Vehreschild <vehre@gmx.de>
* trans-stmt.c (gfc_trans_allocate): For intrinsic functions
use conv_expr_descriptor() instead of conv_expr_reference().
[-- Attachment #3: pr65548_1.patch --]
[-- Type: text/x-patch, Size: 2733 bytes --]
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 6ffae6e79e..68b343b 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5075,12 +5075,17 @@ gfc_trans_allocate (gfc_code * code)
/* 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
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_5.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_5.f90
new file mode 100644
index 0000000..e934e08
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_5.f90
@@ -0,0 +1,52 @@
+! { dg-do run }
+!
+! Check that pr65548 is fixed.
+! Contributed by Juergen Reuter <juergen.reuter@desy.de>
+
+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" } }
+
^ permalink raw reply [flat|nested] 2+ messages in thread