OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [elemental_subroutine_4.f90] - Diff between revs 302 and 384

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 302 Rev 384
! { dg-do compile }
! { dg-do compile }
! Test the fix for PR25099, in which conformance checking was not being
! Test the fix for PR25099, in which conformance checking was not being
! done for elemental subroutines and therefore for interface assignments.
! done for elemental subroutines and therefore for interface assignments.
!
!
! Contributed by Joost VandeVondele  
! Contributed by Joost VandeVondele  
!
!
module elem_assign
module elem_assign
   implicit none
   implicit none
   type mytype
   type mytype
      integer x
      integer x
   end type mytype
   end type mytype
   interface assignment(=)
   interface assignment(=)
      module procedure myassign
      module procedure myassign
   end interface assignment(=)
   end interface assignment(=)
   contains
   contains
      elemental subroutine myassign(x,y)
      elemental subroutine myassign(x,y)
         type(mytype), intent(out) :: x
         type(mytype), intent(out) :: x
         type(mytype), intent(in) :: y
         type(mytype), intent(in) :: y
         x%x = y%x
         x%x = y%x
      end subroutine myassign
      end subroutine myassign
end module elem_assign
end module elem_assign
   use elem_assign
   use elem_assign
   integer :: I(2,2),J(2)
   integer :: I(2,2),J(2)
   type (mytype) :: w(2,2), x(4), y(5), z(4)
   type (mytype) :: w(2,2), x(4), y(5), z(4)
! The original PR
! The original PR
   CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" }
   CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" }
! Check interface assignments
! Check interface assignments
   x = w       ! { dg-error "Incompatible ranks in elemental procedure" }
   x = w       ! { dg-error "Incompatible ranks in elemental procedure" }
   x = y       ! { dg-error "Different shape for elemental procedure" }
   x = y       ! { dg-error "Different shape for elemental procedure" }
   x = z
   x = z
CONTAINS
CONTAINS
   ELEMENTAL SUBROUTINE S(I,J)
   ELEMENTAL SUBROUTINE S(I,J)
     INTEGER, INTENT(IN) :: I,J
     INTEGER, INTENT(IN) :: I,J
   END SUBROUTINE S
   END SUBROUTINE S
END
END
! { dg-final { cleanup-modules "elem_assign" } }
! { dg-final { cleanup-modules "elem_assign" } }
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.