gcc/testsuite/gfortran.dg/assignment_2.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/35033
   4 !
   5 ! The checks for assignments were too strict.
   6 !
   7 MODULE m1
   8           INTERFACE ASSIGNMENT(=)
   9              SUBROUTINE s(a,b)
  10                  REAL,INTENT(OUT) :: a(1,*)
  11                  REAL,INTENT(IN) :: b(:)
  12              END SUBROUTINE
  13           END Interface
  14 contains
  15   subroutine test1()
  16           REAL,POINTER :: p(:,:),q(:)
  17           CALL s(p,q)
  18           p = q
  19   end subroutine test1
  20 end module m1
  21
  22 MODULE m2
  23           INTERFACE ASSIGNMENT(=)
  24              SUBROUTINE s(a,b)
  25                  REAL,INTENT(OUT),VOLATILE :: a(1,*)
  26                  REAL,INTENT(IN) :: b(:)
  27              END SUBROUTINE
  28           END Interface
  29 contains
  30   subroutine test1()
  31           REAL,POINTER :: p(:,:),q(:)
  32           CALL s(p,q) ! { dg-error "requires an assumed-shape or pointer-array dummy" }
  33 !TODO: The following is rightly rejected but the error message is misleading.
  34 ! The actual reason is the mismatch between pointer array and VOLATILE
  35           p = q ! { dg-error "Incompatible ranks" }
  36   end subroutine test1
  37 end module m2
  38
  39 MODULE m3
  40           INTERFACE ASSIGNMENT(=)
  41              module procedure s
  42           END Interface
  43 contains
  44              SUBROUTINE s(a,b) ! { dg-error "must not redefine an INTRINSIC type" }
  45                  REAL,INTENT(OUT),VOLATILE :: a(1,*)
  46                  REAL,INTENT(IN) :: b(:,:)
  47              END SUBROUTINE
  48 end module m3
  49
  50 ! { dg-final { cleanup-modules "m1 m2 m3" } }