Hi all,
this patch fixes a problem with the conversion of scalars to
descriptors. There one assigns the address of the scalar to the
base_address field of the descriptor. The ICE occurred when the RHS (the
scalar) wasn't a pointer.
It does not fully solve the PR as for some reasons the finalization
wrapper is not generated - which causes link errors or ICEs (see PR).
Build and regtested on x86-64-gnu-linux.
OK for the (4.9) trunk?
Tobias
2014-03-25 Tobias Burnus <bur...@net-b.de>
PR fortran/58880
* trans-expr.c (gfc_conv_scalar_to_descriptor): Fix handling
of nonpointers.
2014-03-25 Tobias Burnus <bur...@net-b.de>
PR fortran/58880
* gfortran.dg/finalize_24.f90: New.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index f5350bb..30931a3 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -69,14 +69,16 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
type = get_scalar_to_descriptor_type (scalar, attr);
desc = gfc_create_var (type, "desc");
DECL_ARTIFICIAL (desc) = 1;
+
+ if (!POINTER_TYPE_P (TREE_TYPE (scalar)))
+ scalar = gfc_build_addr_expr (NULL_TREE, scalar);
gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
gfc_get_dtype (type));
gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
/* Copy pointer address back - but only if it could have changed and
if the actual argument is a pointer and not, e.g., NULL(). */
- if ((attr.pointer || attr.allocatable)
- && attr.intent != INTENT_IN && POINTER_TYPE_P (TREE_TYPE (scalar)))
+ if ((attr.pointer || attr.allocatable) && attr.intent != INTENT_IN)
gfc_add_modify (&se->post, scalar,
fold_convert (TREE_TYPE (scalar),
gfc_conv_descriptor_data_get (desc)));
diff --git a/gcc/testsuite/gfortran.dg/finalize_24.f90 b/gcc/testsuite/gfortran.dg/finalize_24.f90
new file mode 100644
index 0000000..2a21858
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_24.f90
@@ -0,0 +1,28 @@
+! { dg-do compile }
+!
+! PR fortran/58880
+!
+! Contributed by Andrew Benson
+!
+
+module gn
+ type sl
+ integer, allocatable, dimension(:) :: lv
+ contains
+ final :: sld
+ end type sl
+ type :: nde
+ type(sl) :: r
+ end type nde
+contains
+ subroutine ndm(s)
+ type(nde), intent(inout) :: s
+ type(nde) :: i
+ i=s
+ end subroutine ndm
+ subroutine sld(s)
+ implicit none
+ type(sl), intent(inout) :: s
+ return
+ end subroutine sld
+end module gn
