Patchwork [Fortran] PR 47448 - fix defined assignment check

login
register
mail settings
Submitter Tobias Burnus
Date Jan. 25, 2011, 12:30 p.m.
Message ID <4D3EC24E.9090907@net-b.de>
Download mbox | patch
Permalink /patch/80351/
State New
Headers show

Comments

Tobias Burnus - Jan. 25, 2011, 12:30 p.m.
Defined assignment ("interface assignment(=)") is not allowed to 
override intrinsic assignments. In particular, it is invalid to override
    array = scalar
    array = array ! for the same rank
while it is valid to use
   scalar = array
   array = array ! for different ranks.

Seemingly before 2009-08-10 (cf. PR 37425) all those where rejected. 
However, with that patch accidentally "array = scalar" and not "scalar = 
array" became accepted.

Thus, the patch below fixes a regression in the sense that no error 
message is printed with 4.5/4.6 for the invalid test case. However, the 
valid case was never allowed.

Build and regtested on x86-64-linux
OK for the trunk? Does anyone want to see this backported to a branch?

Tobias
Jerry DeLisle - Jan. 25, 2011, 1:22 p.m.
On 01/25/2011 04:30 AM, Tobias Burnus wrote:
> Defined assignment ("interface assignment(=)") is not allowed to override
> intrinsic assignments. In particular, it is invalid to override
> array = scalar
> array = array ! for the same rank
> while it is valid to use
> scalar = array
> array = array ! for different ranks.
>
> Seemingly before 2009-08-10 (cf. PR 37425) all those where rejected. However,
> with that patch accidentally "array = scalar" and not "scalar = array" became
> accepted.
>
> Thus, the patch below fixes a regression in the sense that no error message is
> printed with 4.5/4.6 for the invalid test case. However, the valid case was
> never allowed.
>
> Build and regtested on x86-64-linux
> OK for the trunk? Does anyone want to see this backported to a branch?
>

Yes, OK and thanks for quick patch.

Jerry

Patch

2011-01-25  Tobias Burnus  <burnus@net-b.de>

	PR fortran/47448
	* interface.c (gfc_check_operator_interface): Fix
	defined-assignment check.

2011-01-25  Tobias Burnus  <burnus@net-b.de>

	PR fortran/47448
	* gfortran.dg/redefined_intrinsic_assignment_2.f90: New.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 1febb5d..c5b690e 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -654,11 +654,12 @@  gfc_check_operator_interface (gfc_symbol *sym, gfc_intrinsic_op op,
 
       /* Allowed are (per F2003, 12.3.2.1.2 Defined assignments):
 	 - First argument an array with different rank than second,
-	 - Types and kinds do not conform, and
+	 - First argument is a scalar and second an array,
+	 - Types and kinds do not conform, or
 	 - First argument is of derived type.  */
       if (sym->formal->sym->ts.type != BT_DERIVED
 	  && sym->formal->sym->ts.type != BT_CLASS
-	  && (r1 == 0 || r1 == r2)
+	  && (r2 == 0 || r1 == r2)
 	  && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type
 	      || (gfc_numeric_ts (&sym->formal->sym->ts)
 		  && gfc_numeric_ts (&sym->formal->next->sym->ts))))
--- /dev/null	2011-01-14 07:32:07.372000004 +0100
+++ gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90	2011-01-25 11:06:52.000000000 +0100
@@ -0,0 +1,68 @@ 
+! { dg-do compile }
+!
+! PR fortran/47448
+!
+! ASSIGNMENT(=) checks. Defined assignment is allowed if and only if
+! it does not override an intrinsic assignment.
+!
+
+module test1
+  interface assignment(=)
+     module procedure valid, valid2
+  end interface
+contains
+  ! Valid: scalar = array
+  subroutine valid (lhs,rhs)
+    integer, intent(out) ::  lhs
+    integer, intent(in) :: rhs(:)
+    lhs = rhs(1) 
+  end subroutine valid
+
+  ! Valid: array of different ranks
+  subroutine valid2 (lhs,rhs)
+    integer, intent(out) ::  lhs(:)
+    integer, intent(in) :: rhs(:,:)
+    lhs(:) = rhs(:,1) 
+  end subroutine valid2
+end module test1
+
+module test2
+  interface assignment(=)
+     module procedure invalid
+  end interface
+contains
+  ! Invalid: scalar = scalar
+  subroutine invalid (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
+    integer, intent(out) ::  lhs
+    integer, intent(in) :: rhs
+    lhs = rhs
+  end subroutine invalid
+end module test2
+
+module test3
+  interface assignment(=)
+     module procedure invalid2
+  end interface
+contains
+  ! Invalid: array = scalar
+  subroutine invalid2 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
+    integer, intent(out) ::  lhs(:)
+    integer, intent(in) :: rhs
+    lhs(:) = rhs
+  end subroutine invalid2
+end module test3
+
+module test4
+  interface assignment(=)
+     module procedure invalid3
+  end interface
+contains
+  ! Invalid: array = array for same rank
+  subroutine invalid3 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
+    integer, intent(out) ::  lhs(:)
+    integer, intent(in) :: rhs(:)
+    lhs(:) = rhs(:)
+  end subroutine invalid3
+end module test4
+
+! { dg-final { cleanup-modules "test1" } }