OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/47448 (Invalid check for ASSIGNMENT(=))

Browse Source 
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.

From-SVN: r169228
This commit is contained in:
Tobias Burnus 2011-01-25 14:30:32 +01:00 committed by Tobias Burnus
parent 9ffa621ead
commit 315d905fd5
4 changed files with 82 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2011-01-25 Tobias Burnus <burnus@net-b.de>
PR fortran/47448
* interface.c (gfc_check_operator_interface): Fix
defined-assignment check.
2011-01-23 Tobias Burnus <burnus@net-b.de>
PR fortran/47421

5
gcc/fortran/interface.c
View File

@ -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))))

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2011-01-25 Tobias Burnus <burnus@net-b.de>
PR fortran/47448
* gfortran.dg/redefined_intrinsic_assignment_2.f90: New.
2011-01-25 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/47427

68
gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90 Normal file
View File

@ -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" } }