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

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [typebound_call_4.f03] - Blame information for rev 302

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

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do compile }
2
 
3
! Type-bound procedures
4
! Check for recognition/errors with more complicated references and some
5
! error-handling in general.
6
 
7
MODULE m
8
  IMPLICIT NONE
9
 
10
  TYPE t
11
  CONTAINS
12
    PROCEDURE, PASS :: proc
13
    PROCEDURE, NOPASS :: func
14
  END TYPE t
15
 
16
  TYPE compt
17
    TYPE(t) :: myobj
18
  END TYPE compt
19
 
20
CONTAINS
21
 
22
  SUBROUTINE proc (me)
23
    IMPLICIT NONE
24
    CLASS(t), INTENT(INOUT) :: me
25
  END SUBROUTINE proc
26
 
27
  INTEGER FUNCTION func ()
28
    IMPLICIT NONE
29
    func = 1812
30
  END FUNCTION func
31
 
32
  SUBROUTINE test ()
33
    IMPLICIT NONE
34
    TYPE(compt) :: arr(2)
35
 
36
    ! These two are OK.
37
    CALL arr(1)%myobj%proc ()
38
    WRITE (*,*) arr(2)%myobj%func ()
39
 
40
    ! Can't CALL a function or take the result of a SUBROUTINE.
41
    CALL arr(1)%myobj%func () ! { dg-error "SUBROUTINE" }
42
    WRITE (*,*) arr(2)%myobj%proc () ! { dg-error "FUNCTION" }
43
 
44
    ! Error.
45
    CALL arr(2)%myobj%proc () x ! { dg-error "Junk after" }
46
    WRITE (*,*) arr(1)%myobj%func ! { dg-error "Expected argument list" }
47
  END SUBROUTINE test
48
 
49
END MODULE m
50
 
51
! { dg-final { cleanup-modules "m" } }

powered by: WebSVN 2.1.0

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