diff options
author | pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4> | 2017-11-01 09:33:26 +0000 |
---|---|---|
committer | pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4> | 2017-11-01 09:33:26 +0000 |
commit | 5e18f7d64e8c192c6a655aa154659fa5c48778e0 (patch) | |
tree | 510ab7232d2bdc383a8df1584d062a64e8eae539 | |
parent | 13397e0f2d6d9cf08fa39f2251e23876b8d84b6d (diff) | |
download | gcc-5e18f7d64e8c192c6a655aa154659fa5c48778e0.tar.gz |
2017-11-01 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-11-01 Paul Thomas <pault@gcc.gnu.org>
PR fortran/80850
* gfortran.dg/class_64_f90 : New test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-7-branch@254293 138bc75d-0d04-0410-961f-82ee72b054a4
-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" } } |