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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [class_17.f03] - 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 43696: [OOP] Bogus error: Passed-object dummy argument must not be POINTER
4
!
5
! Contributed by Hans-Werner Boschmann 
6
 
7
 
8
MODULE error_stack_module
9
  implicit none
10
 
11
  type,abstract::serializable_class
12
   contains
13
     procedure(ser_DTV_RF),deferred::read_formatted
14
  end type serializable_class
15
 
16
  abstract interface
17
     subroutine ser_DTV_RF(dtv,unit,iotype,v_list,iostat,iomsg)
18
       import serializable_class
19
       CLASS(serializable_class),INTENT(INOUT) :: dtv
20
       INTEGER, INTENT(IN) :: unit
21
       CHARACTER (LEN=*), INTENT(IN) :: iotype
22
       INTEGER, INTENT(IN) :: v_list(:)
23
       INTEGER, INTENT(OUT) :: iostat
24
       CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
25
     end subroutine ser_DTV_RF
26
  end interface
27
 
28
  type,extends(serializable_class)::error_type
29
     class(error_type),pointer::next=>null()
30
   contains
31
     procedure::read_formatted=>error_read_formatted
32
  end type error_type
33
 
34
contains
35
 
36
  recursive subroutine error_read_formatted(dtv,unit,iotype,v_list,iostat,iomsg)
37
    CLASS(error_type),INTENT(INOUT) :: dtv
38
    INTEGER, INTENT(IN) :: unit
39
    CHARACTER (LEN=*), INTENT(IN) :: iotype
40
    INTEGER, INTENT(IN) :: v_list(:)
41
    INTEGER, INTENT(OUT) :: iostat
42
    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
43
    character(8),allocatable::type
44
    character(8),allocatable::next
45
    call basic_read_string(unit,type)
46
    call basic_read_string(unit,next)
47
    if(next=="NEXT")then
48
       allocate(dtv%next)
49
       call dtv%next%read_formatted(unit,iotype,v_list,iostat,iomsg)
50
    end if
51
  end subroutine error_read_formatted
52
 
53
end MODULE error_stack_module
54
 
55
 
56
module b_module
57
  implicit none
58
  type::b_type
59
     class(not_yet_defined_type_type),pointer::b_component  ! { dg-error "is a type that has not been declared" }
60
  end type b_type
61
end module b_module
62
 
63
 
64
! { dg-final { cleanup-modules "error_stack_module b_module" } }

powered by: WebSVN 2.1.0

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