1! RUN: %python %S/test_errors.py %s %flang_fc1 2module m1 3 type t1 4 end type 5 type t3 6 integer t3c 7 end type 8 interface 9 subroutine s1(x) 10 !ERROR: 't1' from host is not accessible 11 import :: t1 12 type(t1) :: x 13 !BECAUSE: 't1' is hidden by this entity 14 integer :: t1 15 end subroutine 16 subroutine s2() 17 !ERROR: 't2' not found in host scope 18 import :: t2 19 end subroutine 20 subroutine s3(x, y) 21 !ERROR: Derived type 't1' not found 22 type(t1) :: x, y 23 end subroutine 24 subroutine s4(x, y) 25 !ERROR: 't3' from host is not accessible 26 import, all 27 type(t1) :: x 28 type(t3) :: y 29 !BECAUSE: 't3' is hidden by this entity 30 integer :: t3 31 end subroutine 32 end interface 33contains 34 subroutine s5() 35 end 36 subroutine s6() 37 import, only: s5 38 implicit none(external) 39 call s5() 40 end 41 subroutine s7() 42 import, only: t1 43 implicit none(external) 44 !ERROR: 's5' is an external procedure without the EXTERNAL attribute in a scope with IMPLICIT NONE(EXTERNAL) 45 call s5() 46 end 47 subroutine s8() 48 !This case is a dangerous ambiguity allowed by the standard. 49 !ERROR: 't1' from host is not accessible 50 type(t1), pointer :: p 51 !BECAUSE: 't1' is hidden by this entity 52 type t1 53 integer n(2) 54 end type 55 end 56 subroutine s9() 57 !This case is a dangerous ambiguity allowed by the standard. 58 type t2 59 !ERROR: 't1' from host is not accessible 60 type(t1), pointer :: p 61 end type 62 !BECAUSE: 't1' is hidden by this entity 63 type t1 64 integer n(2) 65 end type 66 type(t2) x 67 end 68 subroutine s10() 69 !Forward shadowing derived type in IMPLICIT 70 !(supported by all other compilers) 71 implicit type(t1) (c) ! forward shadow 72 implicit type(t3) (d) ! host associated 73 type t1 74 integer a 75 end type 76 c%a = 1 77 d%t3c = 2 78 end 79end module 80module m2 81 integer, parameter :: ck = kind('a') 82end module 83program main 84 use m2 85 interface 86 subroutine s0(x) 87 import :: ck 88 character(kind=ck) :: x ! no error 89 end subroutine 90 end interface 91end program 92