1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic 2! C1577 3program main 4 type t1(k,l) 5 integer, kind :: k = kind(1) 6 integer, len :: l = 666 7 integer(k) n 8 end type t1 9 interface 10 pure integer function ifunc() 11 end function 12 end interface 13 !PORTABILITY: Automatic data object 'x1' should not appear in the specification part of a main program 14 type(t1(k=4,l=ifunc())) x1 15 !PORTABILITY: Statement function 'sf1' should not contain an array constructor 16 sf1(n) = sum([(j,j=1,n)]) 17 type(t1) sf2 18 !PORTABILITY: Statement function 'sf2' should not contain a structure constructor 19 sf2(n) = t1(n) 20 !PORTABILITY: Statement function 'sf3' should not contain a type parameter inquiry 21 sf3(n) = x1%l 22 !ERROR: Recursive call to statement function 'sf4' is not allowed 23 sf4(n) = sf4(n) 24 !ERROR: Statement function 'sf5' may not reference another statement function 'sf6' that is defined later 25 sf5(n) = sf6(n) 26 real sf7 27 !ERROR: Statement function 'sf6' may not reference another statement function 'sf7' that is defined later 28 sf6(n) = sf7(n) 29 !PORTABILITY: Statement function 'sf7' should not reference function 'explicit' that requires an explicit interface 30 sf7(n) = explicit(n) 31 real :: a(3) = [1., 2., 3.] 32 !PORTABILITY: Statement function 'sf8' should not pass an array argument that is not a whole array 33 sf8(n) = sum(a(1:2)) 34 sf8a(n) = sum(a) ! ok 35 integer :: sf9 36 !ERROR: Defining expression of statement function 'sf9' cannot be converted to its result type INTEGER(4) 37 sf9(n) = "bad" 38 !ERROR: Statement function 'sf10' may not reference another statement function 'sf11' that is defined later 39 sf10(n) = sf11(n) 40 sf11(n) = sf10(n) ! mutual recursion, caused crash 41 integer(1) iarg1 42 !PORTABILITY: nonstandard usage: based POINTER 43 pointer(iarg1p, iarg1) 44 sf13(iarg1) = iarg1 45 ! executable part 46 print *, sf13(iarg1) ! ok 47 sf14 = 1. 48 contains 49 real function explicit(x,y) 50 integer, intent(in) :: x 51 integer, intent(in), optional :: y 52 explicit = x 53 end function 54 pure function arr() 55 real :: arr(2) 56 arr = [1., 2.] 57 end function 58 subroutine foo 59 !PORTABILITY: An implicitly typed statement function should not appear when the same symbol is available in its host scope 60 sf14(x) = 2.*x 61 end subroutine 62end 63 64subroutine s0 65 allocatable :: sf 66 !ERROR: 'sf' is not a callable procedure 67 sf(x) = 1. 68end 69 70subroutine s1 71 asynchronous :: sf 72 !ERROR: An entity may not have the ASYNCHRONOUS attribute unless it is a variable 73 sf(x) = 1. 74end 75 76subroutine s2 77 pointer :: sf 78 !ERROR: A statement function must not have the POINTER attribute 79 sf(x) = 1. 80end 81 82subroutine s3 83 save :: sf 84 !ERROR: The entity 'sf' with an explicit SAVE attribute must be a variable, procedure pointer, or COMMON block 85 sf(x) = 1. 86end 87 88subroutine s4 89 volatile :: sf 90 !ERROR: VOLATILE attribute may apply only to a variable 91 sf(x) = 1. 92end 93 94subroutine s5 95 !ERROR: Invalid specification expression: reference to impure function 'k' 96 real x(k()) 97 !WARNING: Name 'k' from host scope should have a type declaration before its local statement function definition 98 !ERROR: 'k' is already declared in this scoping unit 99 k() = 0.0 100end 101