flang/test/Semantics/resolve56.f90

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