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

Subversion Repositories openrisc

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

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-do compile }
!
! PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.
!
! Original test case contributed by Hans-Werner Boschmann 
 
module m
 
  implicit none
 
  type :: t1
   contains
     procedure, nopass :: a => a1
     procedure, nopass :: b => b1
     procedure, nopass :: c => c1
     procedure, nopass :: d => d1
     procedure, nopass :: e => e1
  end type
 
  type, extends(t1) :: t2
   contains
     procedure, nopass :: a => a2  ! { dg-error "Character length mismatch" }
     procedure, nopass :: b => b2  ! { dg-error "should have matching result types and ranks" }
     procedure, nopass :: c => c2  ! { dg-warning "Possible character length mismatch" }
     procedure, nopass :: d => d2  ! valid, check for commutativity (+,*)
     procedure, nopass :: e => e2  ! { dg-error "Character length mismatch" }
  end type
 
contains
 
  function a1 ()
    character(len=6) :: a1
  end function
 
  function a2 ()
    character(len=7) :: a2
  end function
 
  function b1 ()
    integer :: b1
  end function
 
  function b2 ()
    integer, dimension(2) :: b2
  end function
 
  function c1 (x)
    integer, intent(in) :: x
    character(2*x) :: c1
  end function
 
  function c2 (x)
    integer, intent(in) :: x
    character(3*x) :: c2
  end function
 
  function d1 (y)
    integer, intent(in) :: y
    character(2*y+1) :: d1
  end function
 
  function d2 (y)
    integer, intent(in) :: y
    character(1+y*2) :: d2
  end function
 
  function e1 (z)
    integer, intent(in) :: z
    character(3) :: e1
  end function
 
  function e2 (z)
    integer, intent(in) :: z
    character(z) :: e2
  end function
 
end module m
 
 
 
 
module w1
 
 implicit none
 
 integer :: n = 1
 
 type :: tt1
 contains
   procedure, nopass :: aa => aa1
 end type
 
contains
 
 function aa1 (m)
  integer, intent(in) :: m
  character(n+m) :: aa1
 end function
 
end module w1
 
 
module w2
 
 use w1, only : tt1
 
 implicit none
 
 integer :: n = 2
 
 type, extends(tt1) :: tt2
 contains
   procedure, nopass :: aa => aa2  ! { dg-warning "Possible character length mismatch" }
 end type
 
contains
 
 function aa2 (m)
  integer, intent(in) :: m
  character(n+m) :: aa2
 end function
 
end module w2
 
! { dg-final { cleanup-modules "m w1 w2" } }

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do compile }`
2			`!`
3			`! PR 49638: [OOP] length parameter is ignored when overriding type bound character functions with constant length.`
4			`!`
5			`! Original test case contributed by Hans-Werner Boschmann`
6
7			`module m`
8
9			`implicit none`
10
11			`type :: t1`
12			`contains`
13			`procedure, nopass :: a => a1`
14			`procedure, nopass :: b => b1`
15			`procedure, nopass :: c => c1`
16			`procedure, nopass :: d => d1`
17			`procedure, nopass :: e => e1`
18			`end type`
19
20			`type, extends(t1) :: t2`
21			`contains`
22			`procedure, nopass :: a => a2 ! { dg-error "Character length mismatch" }`
23			`procedure, nopass :: b => b2 ! { dg-error "should have matching result types and ranks" }`
24			`procedure, nopass :: c => c2 ! { dg-warning "Possible character length mismatch" }`
25			`procedure, nopass :: d => d2 ! valid, check for commutativity (+,*)`
26			`procedure, nopass :: e => e2 ! { dg-error "Character length mismatch" }`
27			`end type`
28
29			`contains`
30
31			`function a1 ()`
32			`character(len=6) :: a1`
33			`end function`
34
35			`function a2 ()`
36			`character(len=7) :: a2`
37			`end function`
38
39			`function b1 ()`
40			`integer :: b1`
41			`end function`
42
43			`function b2 ()`
44			`integer, dimension(2) :: b2`
45			`end function`
46
47			`function c1 (x)`
48			`integer, intent(in) :: x`
49			`character(2*x) :: c1`
50			`end function`
51
52			`function c2 (x)`
53			`integer, intent(in) :: x`
54			`character(3*x) :: c2`
55			`end function`
56
57			`function d1 (y)`
58			`integer, intent(in) :: y`
59			`character(2*y+1) :: d1`
60			`end function`
61
62			`function d2 (y)`
63			`integer, intent(in) :: y`
64			`character(1+y*2) :: d2`
65			`end function`
66
67			`function e1 (z)`
68			`integer, intent(in) :: z`
69			`character(3) :: e1`
70			`end function`
71
72			`function e2 (z)`
73			`integer, intent(in) :: z`
74			`character(z) :: e2`
75			`end function`
76
77			`end module m`
78
79
80
81
82			`module w1`
83
84			`implicit none`
85
86			`integer :: n = 1`
87
88			`type :: tt1`
89			`contains`
90			`procedure, nopass :: aa => aa1`
91			`end type`
92
93			`contains`
94
95			`function aa1 (m)`
96			`integer, intent(in) :: m`
97			`character(n+m) :: aa1`
98			`end function`
99
100			`end module w1`
101
102
103			`module w2`
104
105			`use w1, only : tt1`
106
107			`implicit none`
108
109			`integer :: n = 2`
110
111			`type, extends(tt1) :: tt2`
112			`contains`
113			`procedure, nopass :: aa => aa2 ! { dg-warning "Possible character length mismatch" }`
114			`end type`
115
116			`contains`
117
118			`function aa2 (m)`
119			`integer, intent(in) :: m`
120			`character(n+m) :: aa2`
121			`end function`
122
123			`end module w2`
124
125			`! { dg-final { cleanup-modules "m w1 w2" } }`

Browse

Tools

Subversion Repositories openrisc

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