OSDN Git Service

2010-06-07 Tobias Burnus <burnus@net-b.de>
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / argument_checking_15.f90
1 ! { dg-do compile }
2 !
3 ! PR fortran/32616
4 !
5 ! Check for to few elements of the actual argument
6 ! and reject mismatching string lengths for assumed-shape dummies
7 !
8 implicit none
9 external test
10 integer :: i(10)
11 integer :: j(2,2)
12 character(len=4) :: str(2)
13 character(len=4) :: str2(2,2)
14
15 call test()
16
17 call foo(i(8)) ! { dg-warning "too few elements for dummy argument 'a' .3/4." }
18 call foo(j(1,1))
19 call foo(j(2,1)) ! { dg-warning "too few elements for dummy argument 'a' .3/4." }
20 call foo(j(1,2)) ! { dg-warning "too few elements for dummy argument 'a' .2/4." }
21
22 str = 'FORT'
23 str2 = 'fort'
24 call bar(str(:)(1:2)) ! { dg-warning "too few elements for dummy argument 'c' .4/6." }
25 call bar(str(1:2)(1:1)) ! { dg-warning "too few elements for dummy argument 'c' .2/6." }
26 call bar(str(2)) ! { dg-warning "too few elements for dummy argument 'c' .4/6." }
27 call bar(str(1)(2:1)) ! OK
28 call bar(str2(2,1)(4:1)) ! OK
29 call bar(str2(1,2)(3:4)) ! OK
30 call bar(str2(1,2)(4:4)) ! { dg-warning "too few elements for dummy argument 'c' .5/6." }
31 contains
32   subroutine foo(a)
33     integer :: a(4)
34   end subroutine foo
35   subroutine bar(c)
36     character(len=2) :: c(3)
37 !    print '(3a)', ':',c(1),':'
38 !    print '(3a)', ':',c(2),':'
39 !    print '(3a)', ':',c(3),':'
40   end subroutine bar
41 end
42
43
44 subroutine test()
45 implicit none
46 character(len=5), pointer :: c
47 character(len=5) :: str(5)
48 call foo(c) ! { dg-error "Character length mismatch" }
49 call bar(str) ! { dg-error "Character length mismatch" }
50 contains
51   subroutine foo(a)
52     character(len=3), pointer :: a
53   end subroutine
54   subroutine bar(a)
55     character(len=3) :: a(:)
56   end subroutine bar
57 end subroutine test