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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
!
3
! This tests the improved version of the patch for PR16861.  Testing
4
! after committing the first version, revealed that this test did
5
! not work but was not regtested for, either.
6
!
7
! Contributed by Paul Thomas 
8
!
9
MODULE foo
10
  TYPE type1
11
    INTEGER i1
12
  END TYPE type1
13
END MODULE
14
 
15
MODULE bar
16
CONTAINS
17
  SUBROUTINE sub1 (x, y)
18
    USE foo
19
    TYPE (type1)  :: x
20
    INTEGER  :: y(x%i1)
21
    y = 1
22
  END SUBROUTINE SUB1
23
  SUBROUTINE sub2 (u, v)
24
    USE foo
25
    TYPE (type1)  :: u
26
    INTEGER  :: v(u%i1)
27
    v = 2
28
  END SUBROUTINE SUB2
29
END MODULE
30
 
31
MODULE foobar
32
  USE foo
33
  USE bar
34
CONTAINS
35
  SUBROUTINE sub3 (s, t)
36
    USE foo
37
    TYPE (type1)  :: s
38
    INTEGER  :: t(s%i1)
39
    t = 3
40
  END SUBROUTINE SUB3
41
END MODULE foobar
42
 
43
PROGRAM use_foobar
44
  USE foo
45
  USE foobar
46
  INTEGER :: j(3) = 0
47
  TYPE (type1)   :: z
48
  z%i1 = 3
49
  CALL sub1 (z, j)
50
  z%i1 = 2
51
  CALL sub2 (z, j)
52
  z%i1 = 1
53
  CALL sub3 (z, j)
54
  IF (ALL (j.ne.(/3,2,1/))) CALL abort ()
55
END PROGRAM use_foobar
56
 
57
! { dg-final { cleanup-modules "foo bar foobar" } }

powered by: WebSVN 2.1.0

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