diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 37 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/class_64.f90 | 38 |
4 files changed, 87 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 41215a88338..0c25ce212f7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2017-11-01 Paul Thomas <pault@gcc.gnu.org> + + Backport from trunk + 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-28 Andre Vehreschild <vehre@gcc.gnu.org> * check.c (gfc_check_co_reduce): Clarify error message. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 36046deb010..fa04ed45419 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); } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cf1fb72082b..8057858d771 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2017-11-01 Paul Thomas <pault@gcc.gnu.org> + + Backported from trunk + PR fortran/80850 + * gfortran.dg/class_64_f90 : New test. + 2017-10-30 Paolo Carlini <paolo.carlini@oracle.com> PR c++/82085 diff --git a/gcc/testsuite/gfortran.dg/class_64.f90 b/gcc/testsuite/gfortran.dg/class_64.f90 new file mode 100644 index 00000000000..059ebaa8a01 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_64.f90 @@ -0,0 +1,38 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR80850 in which the _len field was not being +! set for 'arg' in the call to 'foo'. +! + type :: mytype + integer :: i + end type + class (mytype), pointer :: c + + allocate (c, source = mytype (99_8)) + + call foo(c) + call bar(c) + + deallocate (c) + +contains + + subroutine foo (arg) + class(*) :: arg + select type (arg) + type is (mytype) + if (arg%i .ne. 99_8) call abort + end select + end subroutine + + subroutine bar (arg) + class(mytype) :: arg + select type (arg) + type is (mytype) + if (arg%i .ne. 99_8) call abort + end select + end subroutine + +end +! { dg-final { scan-tree-dump-times "arg.*._len" 1 "original" } } |