flang/test/Semantics/resolve56.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   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)
  67 end