OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/65548 (gfc_conv_procedure_call) 

PR fortran/65548
        * gfortran.dg/allocate_with_source_5.f90: New test.

        * trans-stmt.c (gfc_trans_allocate): For intrinsic functions
        use conv_expr_descriptor() instead of conv_expr_reference().

From-SVN: r221897
This commit is contained in:
Andre Vehreschild 2015-04-07 16:10:43 +02:00 committed by Andre Vehreschild
parent 0e081bde91
commit 440f9408ea
4 changed files with 70 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2015-04-07 Andre Vehreschild <vehre@gmx.de>
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 <jakub@redhat.com>
PR fortran/65597

9
gcc/fortran/trans-stmt.c
View File

@ -5049,12 +5049,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

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2015-04-07 Andre Vehreschild <vehre@gmx.de>
PR fortran/65548
* gfortran.dg/allocate_with_source_5.f90: New test.
2015-04-07 Ilya Enkovich <ilya.enkovich@intel.com>
* gcc.target/i386/mpx/chkp-thunk-comdat-1.cc: New.

52
gcc/testsuite/gfortran.dg/allocate_with_source_5.f90 Normal file
View File

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