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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
!
3
! PR fortran/37445, in which the first version of the fix regressed on the
4
! calls to GetBasicElementData; picking up the local GetBasicElementData instead.
5
!
6
! Contributed by Norman S Clerman < clerman@fuse.net>
7
! and reduced by Tobias Burnus 
8
!
9
MODULE ErrElmnt
10
  IMPLICIT NONE
11
  TYPE :: TErrorElement
12
    integer :: i
13
  end type TErrorElement
14
contains
15
  subroutine GetBasicData ( AnElement, ProcedureName, ErrorNumber,    &
16
                            Level, Message, ReturnStat)
17
    type (TErrorElement) :: AnElement
18
    character (*, 1), optional ::       &
19
      ProcedureName
20
    integer (4), optional :: ErrorNumber
21
    character (*, 1), optional :: Level
22
    character (*, 1), optional :: Message
23
    integer (4), optional :: ReturnStat
24
  end subroutine GetBasicData
25
end module ErrElmnt
26
 
27
MODULE ErrorMod
28
  USE ErrElmnt, only: GetBasicElementData => GetBasicData , TErrorElement
29
  IMPLICIT NONE
30
contains
31
  subroutine GetBasicData ()
32
    integer (4) :: CallingStat, LocalErrorNum
33
    character (20, 1) :: LocalErrorMessage
34
    character (20, 1) :: LocalProcName
35
    character (20, 1) :: Locallevel
36
    type (TErrorElement) :: AnElement
37
    call GetBasicElementData (AnElement, LocalProcName, LocalErrorNum, LocalLevel, LocalErrorMessage, CallingStat)
38
  end subroutine GetBasicData
39
  SUBROUTINE WH_ERR ()
40
    integer (4) :: ErrorNumber, CallingStat
41
    character (20, 1) :: ProcedureName
42
    character (20, 1) :: ErrorLevel
43
    character (20, 1) :: ErrorMessage
44
    type (TErrorElement) :: TargetElement
45
    call GetBasicElementData (TargetElement, ProcedureName, ErrorNumber, ErrorLevel, ErrorMessage, CallingStat)
46
  end subroutine WH_ERR
47
end module ErrorMod
48
! { dg-final { cleanup-modules "errelmnt errormod" } }

powered by: WebSVN 2.1.0

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