@@ -1,3 +1,11 @@
+2014-07-19 Andre Vehreschild <vehre@gmx.de>
+
+ PR fortran/60414
+ * interface.c (compare_parameter): Fix compile bug: During resolution
+ of generic an array reference in the actual argument was not
+ respected. Fixed by checking, if the ref member is non-null. Testcase
+ unlimited_polymorphism_18.f90 add.
+
2014-06-15 Tobias Burnus <burnus@net-b.de>
* symbol.c (check_conflict): Add codimension conflict with
@@ -2156,7 +2156,10 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
if (symbol_rank (formal) == actual->rank || symbol_rank (formal) == -1)
return 1;
+ /* Only check ranks compatibility, if actual is not an array reference,
+ i.e., actual(i) indicated by actual->ref being set. */
if (actual->ts.type == BT_CLASS && CLASS_DATA (actual)->as
+ && !actual->ref
&& CLASS_DATA (actual)->as->rank == symbol_rank (formal))
return 1;
@@ -1,3 +1,8 @@
+2014-07-19 Andre Vehreschild <vehre@gmx.de>
+
+ * gfortran.dg/unlimited_polymorphism_18.f90: Check according to
+ PR 60414
+
2014-07-18 Uros Bizjak <ubizjak@gmail.com>
PR target/61794
new file mode 100644
@@ -0,0 +1,66 @@
+! { dg-do run }
+! Tests fix for PR60414
+!
+module m
+ implicit none
+ Type T
+ contains
+ procedure :: FWrite
+ procedure :: FWriteArr
+ generic :: Write => FWrite, FWriteArr
+ end Type
+
+contains
+
+ subroutine FWrite(this,X)
+ class(T) this
+ class(*) X
+ real :: r
+ select type(X)
+ type is (real)
+ write (*, "(f3.1)", advance='no') X
+ class default
+ write (*, *) "???"
+ end select
+ end subroutine FWrite
+
+ subroutine FWriteArr(this,X)
+ class(T) this
+ class(*) X(:)
+ integer i
+ do i = 1,6
+ call this%fwrite(X(i))
+ write (*, "(a)", advance="no") ", "
+ end do
+ end subroutine FWriteARr
+
+ subroutine WriteTextVector(vec, n, scal)
+ integer, intent(in) :: n
+ class(*), intent(in) :: vec(n)
+ class(*), intent(in) :: scal
+ integer j
+ Type(T) :: Tester
+
+ ! Write full vector
+ call Tester%Write(vec)
+ print *, ""
+ ! Write a scalar of the same class like the vector
+ call Tester%Write(scal)
+ print *, ""
+ ! Write an element of the vector, which is a scalar
+ j=3
+ call Tester%Write(vec(j))
+
+ end subroutine WriteTextVector
+
+end module
+
+program test
+ use :: m
+ implicit none
+
+ real :: vec(1:6) = (/ 0, 1, 2, 3, 4, 5 /)
+ call writetextvector(vec, 6, 5.0)
+end program test
+! { dg-final { cleanup-modules "m" } }
+