! { dg-do compile }
|
! { dg-do compile }
|
! { dg-options "-std=legacy" }
|
! { dg-options "-std=legacy" }
|
! Tests the patch for PRs 25084, 20852, 25085 and 25086, all of
|
! Tests the patch for PRs 25084, 20852, 25085 and 25086, all of
|
! which involve assumed character length functions.
|
! which involve assumed character length functions.
|
! Compiled from original PR testcases, which were all contributed
|
! Compiled from original PR testcases, which were all contributed
|
! by Joost VandeVondele
|
! by Joost VandeVondele
|
!
|
!
|
! PR25084 - the error is not here but in any use of .IN.
|
! PR25084 - the error is not here but in any use of .IN.
|
! It is OK to define an assumed character length function
|
! It is OK to define an assumed character length function
|
! in an interface but it cannot be invoked (5.1.1.5).
|
! in an interface but it cannot be invoked (5.1.1.5).
|
|
|
MODULE M1
|
MODULE M1
|
TYPE SET
|
TYPE SET
|
INTEGER CARD
|
INTEGER CARD
|
END TYPE SET
|
END TYPE SET
|
END MODULE M1
|
END MODULE M1
|
|
|
MODULE INTEGER_SETS
|
MODULE INTEGER_SETS
|
INTERFACE OPERATOR (.IN.)
|
INTERFACE OPERATOR (.IN.)
|
FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" }
|
FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" }
|
USE M1
|
USE M1
|
CHARACTER(LEN=*) :: ELEMENT
|
CHARACTER(LEN=*) :: ELEMENT
|
INTEGER, INTENT(IN) :: X
|
INTEGER, INTENT(IN) :: X
|
TYPE(SET), INTENT(IN) :: A
|
TYPE(SET), INTENT(IN) :: A
|
END FUNCTION ELEMENT
|
END FUNCTION ELEMENT
|
END INTERFACE
|
END INTERFACE
|
END MODULE
|
END MODULE
|
|
|
! 5.1.1.5 of the Standard: A function name declared with an asterisk
|
! 5.1.1.5 of the Standard: A function name declared with an asterisk
|
! char-len-param shall not be array-valued, pointer-valued, recursive
|
! char-len-param shall not be array-valued, pointer-valued, recursive
|
! or pure
|
! or pure
|
!
|
!
|
! PR20852
|
! PR20852
|
RECURSIVE FUNCTION TEST() ! { dg-error "cannot be recursive" }
|
RECURSIVE FUNCTION TEST() ! { dg-error "cannot be recursive" }
|
CHARACTER(LEN=*) :: TEST
|
CHARACTER(LEN=*) :: TEST
|
TEST = ""
|
TEST = ""
|
END FUNCTION
|
END FUNCTION
|
|
|
!PR25085
|
!PR25085
|
FUNCTION F1() ! { dg-error "cannot be array-valued" }
|
FUNCTION F1() ! { dg-error "cannot be array-valued" }
|
CHARACTER(LEN=*), DIMENSION(10) :: F1
|
CHARACTER(LEN=*), DIMENSION(10) :: F1
|
F1 = ""
|
F1 = ""
|
END FUNCTION F1
|
END FUNCTION F1
|
|
|
!PR25086
|
!PR25086
|
FUNCTION F2() result(f4) ! { dg-error "cannot be pointer-valued" }
|
FUNCTION F2() result(f4) ! { dg-error "cannot be pointer-valued" }
|
CHARACTER(LEN=*), POINTER :: f4
|
CHARACTER(LEN=*), POINTER :: f4
|
f4 = ""
|
f4 = ""
|
END FUNCTION F2
|
END FUNCTION F2
|
|
|
!PR?????
|
!PR?????
|
pure FUNCTION F3() ! { dg-error "cannot be pure" }
|
pure FUNCTION F3() ! { dg-error "cannot be pure" }
|
CHARACTER(LEN=*) :: F3
|
CHARACTER(LEN=*) :: F3
|
F3 = ""
|
F3 = ""
|
END FUNCTION F3
|
END FUNCTION F3
|
|
|
function not_OK (ch)
|
function not_OK (ch)
|
character(*) not_OK, ch ! OK in an external function
|
character(*) not_OK, ch ! OK in an external function
|
not_OK = ch
|
not_OK = ch
|
end function not_OK
|
end function not_OK
|
|
|
use m1
|
use m1
|
|
|
character(4) :: answer
|
character(4) :: answer
|
character(*), external :: not_OK
|
character(*), external :: not_OK
|
integer :: i
|
integer :: i
|
type (set) :: z
|
type (set) :: z
|
|
|
interface
|
interface
|
function ext (i)
|
function ext (i)
|
character(*) :: ext
|
character(*) :: ext
|
integer :: i
|
integer :: i
|
end function ext
|
end function ext
|
end interface
|
end interface
|
|
|
answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }
|
answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }
|
|
|
END
|
END
|
|
|
! { dg-final { cleanup-modules "M1" } }
|
! { dg-final { cleanup-modules "M1" } }
|
|
|
