diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2017-10-30 22:07:25 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2017-10-30 22:07:25 +0000 |
| commit | 59d7953a634a71f09d02b37ad3031b17ade60d15 (patch) | |
| tree | 287560dcf2ccf6975fc74b2fe5662da3698f6094 /gcc/fortran/trans-expr.c | |
| parent | 8581ce0a9d73021b110849b3992df0fc88978b6c (diff) | |
| download | gcc-59d7953a634a71f09d02b37ad3031b17ade60d15.zip gcc-59d7953a634a71f09d02b37ad3031b17ade60d15.tar.gz gcc-59d7953a634a71f09d02b37ad3031b17ade60d15.tar.bz2 | |
re PR libfortran/80850 (Sourced allocate() fails to allocate a pointer)
2017-10-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/80850
* trans_expr.c (gfc_conv_procedure_call): When passing a class
argument to an unlimited polymorphic dummy, it is wrong to cast
the passed expression as unlimited, unless it is unlimited. The
correct way is to assign to each of the fields and set the _len
field to zero.
2017-10-30 Paul Thomas <pault@gcc.gnu.org>
PR fortran/80850
* gfortran.dg/class_64_f90 : New test.
From-SVN: r254244
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 37 |
1 files changed, 33 insertions, 4 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 71ec176..1a3e3d4 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5173,10 +5173,39 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } else { - gfc_add_modify (&parmse.pre, var, - fold_build1_loc (input_location, - VIEW_CONVERT_EXPR, - type, parmse.expr)); + /* Since the internal representation of unlimited + polymorphic expressions includes an extra field + that other class objects do not, a cast to the + formal type does not work. */ + if (!UNLIMITED_POLY (e) && UNLIMITED_POLY (fsym)) + { + tree efield; + + /* Set the _data field. */ + tmp = gfc_class_data_get (var); + efield = fold_convert (TREE_TYPE (tmp), + gfc_class_data_get (parmse.expr)); + gfc_add_modify (&parmse.pre, tmp, efield); + + /* Set the _vptr field. */ + tmp = gfc_class_vptr_get (var); + efield = fold_convert (TREE_TYPE (tmp), + gfc_class_vptr_get (parmse.expr)); + gfc_add_modify (&parmse.pre, tmp, efield); + + /* Set the _len field. */ + tmp = gfc_class_len_get (var); + gfc_add_modify (&parmse.pre, tmp, + build_int_cst (TREE_TYPE (tmp), 0)); + } + else + { + tmp = fold_build1_loc (input_location, + VIEW_CONVERT_EXPR, + type, parmse.expr); + gfc_add_modify (&parmse.pre, var, tmp); + ; + } parmse.expr = gfc_build_addr_expr (NULL_TREE, var); } } |