Re: [Patch, fortran, pr65548, v1] [5 Regression] gfc_conv_procedure_call

Re: [Patch, fortran, pr65548, v1] [5 Regression] gfc_conv_procedure_call

[Dominique Dhumieres]

> please find attached a fix for the recently introduced regression when
> allocating arrays with an intrinsic function for source=. ...

I confirm that the patch fixes pr65548 without regression.

Thanks,

Dominique

[Patch, fortran, pr65548, v1] [5 Regression] gfc_conv_procedure_call

[Andre Vehreschild]

[-- 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" } }
+