diff options
| author | Janus Weil <janus@gcc.gnu.org> | 2010-07-29 20:14:16 +0200 |
|---|---|---|
| committer | Janus Weil <janus@gcc.gnu.org> | 2010-07-29 20:14:16 +0200 |
| commit | b2a5eb7501657692da7d9d294758753e122b3691 (patch) | |
| tree | a67dba99dceef9faa3716776308033df861b23c1 /gcc/fortran/trans-intrinsic.c | |
| parent | a3378ceac91930adf5d5f2f95ca2874c14b6f6f1 (diff) | |
| download | gcc-b2a5eb7501657692da7d9d294758753e122b3691.zip gcc-b2a5eb7501657692da7d9d294758753e122b3691.tar.gz gcc-b2a5eb7501657692da7d9d294758753e122b3691.tar.bz2 | |
re PR fortran/45004 ([OOP] Segfault with allocatable scalars and move_alloc)
2010-07-29 Janus Weil <janus@gcc.gnu.org>
PR fortran/45004
* trans-stmt.h (gfc_trans_class_init_assign): New prototype.
(gfc_trans_class_assign): Modified prototype.
* trans.h (gfc_conv_intrinsic_move_alloc): New prototype.
* trans-expr.c (gfc_trans_class_init_assign): Split off from ...
(gfc_trans_class_assign): ... here. Modified actual arguments.
* trans-intrinsic.c (gfc_conv_intrinsic_move_alloc): New function to
handle the MOVE_ALLOC intrinsic with scalar and class arguments.
* trans.c (trans_code): Call 'gfc_conv_intrinsic_move_alloc'.
2010-07-29 Janus Weil <janus@gcc.gnu.org>
PR fortran/45004
* gfortran.dg/move_alloc_2.f90: New.
From-SVN: r162688
Diffstat (limited to 'gcc/fortran/trans-intrinsic.c')
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 38 |
1 files changed, 38 insertions, 0 deletions
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index c277e8e..a576076 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5559,4 +5559,42 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, } } + +tree +gfc_conv_intrinsic_move_alloc (gfc_code *code) +{ + if (code->ext.actual->expr->rank == 0) + { + /* Scalar arguments: Generate pointer assignments. */ + gfc_expr *from, *to; + stmtblock_t block; + tree tmp; + + from = code->ext.actual->expr; + to = code->ext.actual->next->expr; + + gfc_start_block (&block); + + if (to->ts.type == BT_CLASS) + tmp = gfc_trans_class_assign (to, from, EXEC_POINTER_ASSIGN); + else + tmp = gfc_trans_pointer_assignment (to, from); + gfc_add_expr_to_block (&block, tmp); + + if (from->ts.type == BT_CLASS) + tmp = gfc_trans_class_assign (from, gfc_get_null_expr (NULL), + EXEC_POINTER_ASSIGN); + else + tmp = gfc_trans_pointer_assignment (from, + gfc_get_null_expr (NULL)); + gfc_add_expr_to_block (&block, tmp); + + return gfc_finish_block (&block); + } + else + /* Array arguments: Generate library code. */ + return gfc_trans_call (code, false, NULL_TREE, NULL_TREE, false); +} + + #include "gt-fortran-trans-intrinsic.h" |