diff options
| author | Bernd Edlinger <bernd.edlinger@hotmail.de> | 2014-12-10 15:29:19 +0000 |
|---|---|---|
| committer | Bernd Edlinger <edlinger@gcc.gnu.org> | 2014-12-10 15:29:19 +0000 |
| commit | 301375fdd557a3ae056580ee3f692ce2bbcc67ad (patch) | |
| tree | 9846d76a16419247ccbfb3e90de4017076721789 /gcc/fortran/trans-expr.c | |
| parent | d7290d1cf47c1b910823af3d42075a76b46b0c31 (diff) | |
| download | gcc-301375fdd557a3ae056580ee3f692ce2bbcc67ad.zip gcc-301375fdd557a3ae056580ee3f692ce2bbcc67ad.tar.gz gcc-301375fdd557a3ae056580ee3f692ce2bbcc67ad.tar.bz2 | |
re PR fortran/60718 (Test case gfortran.dg/select_type_4.f90 fails on ARM)
2014-12-10 Bernd Edlinger <bernd.edlinger@hotmail.de>
PR fortran/60718
* trans-expr.c (gfc_conv_procedure_call): Fix a strict aliasing
violation when passing a class object to a formal parameter which has
different pointer or allocatable attributes.
testsuite:
2014-12-10 Bernd Edlinger <bernd.edlinger@hotmail.de>
PR fortran/60718
* gfortran.dg/class_alias.f90: New.
From-SVN: r218584
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7bdcc72..a82203c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4430,6 +4430,55 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, fsym->attr.optional && e->expr_type == EXPR_VARIABLE); } + else if (e->ts.type == BT_CLASS && fsym + && fsym->ts.type == BT_CLASS + && !CLASS_DATA (fsym)->as + && !CLASS_DATA (e)->as + && (CLASS_DATA (fsym)->attr.class_pointer + != CLASS_DATA (e)->attr.class_pointer + || CLASS_DATA (fsym)->attr.allocatable + != CLASS_DATA (e)->attr.allocatable)) + { + type = gfc_typenode_for_spec (&fsym->ts); + var = gfc_create_var (type, fsym->name); + gfc_conv_expr (&parmse, e); + if (fsym->attr.optional + && e->expr_type == EXPR_VARIABLE + && e->symtree->n.sym->attr.optional) + { + stmtblock_t block; + tree cond; + tmp = gfc_build_addr_expr (NULL_TREE, parmse.expr); + cond = fold_build2_loc (input_location, NE_EXPR, + boolean_type_node, tmp, + fold_convert (TREE_TYPE (tmp), + null_pointer_node)); + gfc_start_block (&block); + gfc_add_modify (&block, var, + fold_build1_loc (input_location, + VIEW_CONVERT_EXPR, + type, parmse.expr)); + gfc_add_expr_to_block (&parmse.pre, + fold_build3_loc (input_location, + COND_EXPR, void_type_node, + cond, gfc_finish_block (&block), + build_empty_stmt (input_location))); + parmse.expr = gfc_build_addr_expr (NULL_TREE, var); + parmse.expr = build3_loc (input_location, COND_EXPR, + TREE_TYPE (parmse.expr), + cond, parmse.expr, + fold_convert (TREE_TYPE (parmse.expr), + null_pointer_node)); + } + else + { + gfc_add_modify (&parmse.pre, var, + fold_build1_loc (input_location, + VIEW_CONVERT_EXPR, + type, parmse.expr)); + parmse.expr = gfc_build_addr_expr (NULL_TREE, var); + } + } else gfc_conv_expr_reference (&parmse, e); |