OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [argument_checking_15.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { 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-warning "Character length mismatch" }
49
call bar(str) ! { dg-warning "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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.