Re: PR 60414: Patch proposal

[Andre Vehreschild <vehre@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 1823 bytes --]

Hi FX,

thank you for your help:

ad 1) I thought the fixes to small for all the trouble to go through with a
copyright assignment. But if it is needed, I will happily give copyright to the
FSF and negotiate with my client all formal requirements. Unfortunately my
English is not well enough to understand the legal English on the site you
pointed me to. May I ask you to help me there? Is there a form I have to sign?
Where to I get it? What do you need from my client?

ad 2) Patch bootstrapped and regtested on x86_64-unknown-linux-gnu on a
standard PC running Fedora 19 (64 bit).

I have to apologize for the incomplete patch: The testcase
unlimited_polymorphism_18.f90 was missing. My fault. Please find the corrected
patch attached.

Regards,
	Andre

On Sat, 19 Jul 2014 00:12:13 +0200
FX <fxcoudert@gmail.com> wrote:

> Hi Andre, and welcome aboard!
> 
> The explanation you give is nice, your patch submission looks clean. Two
> things:
> 
>   1. Do you have a copyright assignment on file with the FSF? See
> https://gcc.gnu.org/contribute.html
> 
>   2. Normally, all GCC patch submissions should be accompanied by a statement
> saying how you tested the patch. The standard thing to do is to check that
> the patched sources still bootstrap and that there is no regression in the
> testsuite. This can be stated as “Patch bootstrapped and regtested on <insert
> here your testing platform triplet, like x86_64-apple-darwin13>”. In that
> particular case, it might also be nice to indicate that not only the testcase
> doesnÂ’t crash the compiler any more, but to confirm that it now generates the
> correct code (i.e. that we donÂ’t turn an ice-on-valid bug into a wrong-code
> bug!).
> 
> Cheers,
> FX
> 


-- 
Andre Vehreschild * Kreuzherrenstr. 8 * 52062 Aachen
Tel.: +49 241 9291018 * Email: vehre@gmx.de 

[-- Attachment #2: pr60414_2.patch --]
[-- Type: text/x-patch, Size: 3393 bytes --]

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c33936b..cb01a13 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index b210d18..8658003 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3202694..01d770f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_18.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_18.f90
new file mode 100644
index 0000000..661d0b7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_18.f90
@@ -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" } }
+