• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1! RUN: %S/test_errors.sh %s %t %f18
2! Test that associations constructs can be correctly combined. The intrinsic
3! functions are not what is tested here, they are only use to reveal the types
4! of local variables.
5
6  implicit none
7  real res
8  complex zres
9  integer ires
10  class(*), allocatable :: a, b
11  select type(a)
12    type is (integer)
13      select type(b)
14        type is (integer)
15          ires = selected_int_kind(b)
16          ires = selected_int_kind(a)
17      end select
18    type is (real)
19     res = acos(a)
20     !ERROR: Actual argument for 'x=' has bad type 'CLASS(*)'
21     res = acos(b)
22  end select
23
24  select type(c => a)
25    type is (real)
26     res = acos(c)
27    class default
28     !ERROR: Actual argument for 'x=' has bad type 'CLASS(*)'
29     res = acos(c)
30  end select
31  select type(a)
32    type is (integer)
33     !ERROR: Actual argument for 'x=' has bad type 'INTEGER(4)'
34     res = acos(a)
35  end select
36
37  select type(b)
38    type is (integer)
39      associate(y=>1.0, x=>1, z=>(1.0,2.3))
40        ires = selected_int_kind(x)
41        select type(a)
42          type is (real)
43            res = acos(a)
44            res = acos(y)
45            !ERROR: Actual argument for 'x=' has bad type 'INTEGER(4)'
46            res = acos(b)
47          type is (integer)
48            ires = selected_int_kind(b)
49            zres = acos(z)
50           !ERROR: Actual argument for 'x=' has bad type 'INTEGER(4)'
51           res = acos(a)
52        end select
53      end associate
54      ires = selected_int_kind(b)
55      !ERROR: No explicit type declared for 'c'
56      ires = selected_int_kind(c)
57      !ERROR: Actual argument for 'x=' has bad type 'CLASS(*)'
58      res = acos(a)
59    class default
60      !ERROR: Actual argument for 'r=' has bad type 'CLASS(*)'
61      ires = selected_int_kind(b)
62  end select
63  !ERROR: Actual argument for 'r=' has bad type 'CLASS(*)'
64  ires = selected_int_kind(a)
65  !ERROR: Actual argument for 'x=' has bad type 'CLASS(*)'
66  res = acos(b)
67end
68