diff mbox

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

Message ID 20150325143554.0343a7a7@vepi2
State New
Headers show

Commit Message

Andre Vehreschild March 25, 2015, 1:35 p.m. UTC 
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

Comments

Andre Vehreschild April 2, 2015, 10:28 a.m. UTC | #1 
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 <vehre@gmx.de> 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?
> 
> Regards,
> 	Andre
Jerry DeLisle April 3, 2015, 12:06 a.m. UTC | #2 
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 <vehre@gmx.de> 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
diff mbox

Patch

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