diff options
| author | Tobias Burnus <burnus@net-b.de> | 2013-10-16 22:46:33 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2013-10-16 22:46:33 +0200 |
| commit | a8267f8d58e17be205e1147de957f059db88c739 (patch) | |
| tree | 33f03339be8340a034cb8d2a9c2eac39e8775fb3 | |
| parent | 931519141b20dceeb5397281ed7fdead3e613213 (diff) | |
| download | gcc-a8267f8d58e17be205e1147de957f059db88c739.zip gcc-a8267f8d58e17be205e1147de957f059db88c739.tar.gz gcc-a8267f8d58e17be205e1147de957f059db88c739.tar.bz2 | |
re PR fortran/58652 (ICE with move_alloc and unlimited polymorphic)
2013-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/58652
* interface.c (compare_parameter): Accept passing CLASS(*)
to CLASS(*).
2013-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/58652
* gfortran.dg/unlimited_polymorphic_12.f90: New.
From-SVN: r203720
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 5 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/unlimited_polymorphic_12.f90 | 44 |
4 files changed, 58 insertions, 2 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ee6b8ed..068a11d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,11 @@ 2013-10-16 Tobias Burnus <burnus@net-b.de> + PR fortran/58652 + * interface.c (compare_parameter): Accept passing CLASS(*) + to CLASS(*). + +2013-10-16 Tobias Burnus <burnus@net-b.de> + * intrinsic.texi (OpenMP Modules): Update to OpenMPv4. Document omp_proc_bind_kind. diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index b878644..b3ddf5f 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1990,8 +1990,9 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual, if (!gfc_expr_attr (actual).class_ok) return 0; - if (!gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived, - CLASS_DATA (formal)->ts.u.derived)) + if ((!UNLIMITED_POLY (formal) || !UNLIMITED_POLY(actual)) + && !gfc_compare_derived_types (CLASS_DATA (actual)->ts.u.derived, + CLASS_DATA (formal)->ts.u.derived)) { if (where) gfc_error ("Actual argument to '%s' at %L must have the same " diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fb246c5..faf76bd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-10-16 Tobias Burnus <burnus@net-b.de> + + PR fortran/58652 + * gfortran.dg/unlimited_polymorphic_12.f90: New. + 2013-10-16 Thomas Schwinge <thomas@codesourcery.com> * c-c++-common/cpp/openmp-define-1.c: Move diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_12.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_12.f90 new file mode 100644 index 0000000..c583c6b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_12.f90 @@ -0,0 +1,44 @@ +! { dg-do compile } +! +! PR fortran/58652 +! +! Contributed by Vladimir Fuka +! +! The passing of a CLASS(*) to a CLASS(*) was reject before +! +module gen_lists + type list_node + class(*),allocatable :: item + contains + procedure :: move_alloc => list_move_alloc + end type + + contains + + subroutine list_move_alloc(self,item) + class(list_node),intent(inout) :: self + class(*),intent(inout),allocatable :: item + + call move_alloc(item, self%item) + end subroutine +end module + +module lists + use gen_lists, only: node => list_node +end module lists + + +module sexp + use lists +contains + subroutine parse(ast) + class(*), allocatable, intent(out) :: ast + class(*), allocatable :: expr + integer :: ierr + allocate(node::ast) + select type (ast) + type is (node) + call ast%move_alloc(expr) + end select + end subroutine +end module |