flang/test/Semantics/call01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
   2 ! Confirm enforcement of constraints and restrictions in 15.6.2.1
   3
   4 non_recursive function f01(n) result(res)
   5   integer, value :: n
   6   integer :: res
   7   if (n <= 0) then
   8     res = n
   9   else
  10     !ERROR: NON_RECURSIVE procedure 'f01' cannot call itself
  11     res = n * f01(n-1) ! 15.6.2.1(3)
  12   end if
  13 end function
  14
  15 non_recursive function f02(n) result(res)
  16   integer, value :: n
  17   integer :: res
  18   if (n <= 0) then
  19     res = n
  20   else
  21     res = nested()
  22   end if
  23  contains
  24   integer function nested()
  25     !ERROR: NON_RECURSIVE procedure 'f02' cannot call itself
  26     nested = n * f02(n-1) ! 15.6.2.1(3)
  27   end function nested
  28 end function
  29
  30 !ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
  31 recursive character(*) function f03(n) ! C723
  32   integer, value :: n
  33   f03 = ''
  34 end function
  35
  36 !ERROR: An assumed-length CHARACTER(*) function cannot be RECURSIVE
  37 recursive function f04(n) result(res) ! C723
  38   integer, value :: n
  39   character(*) :: res
  40   res = ''
  41 end function
  42
  43 !ERROR: An assumed-length CHARACTER(*) function cannot return an array
  44 character(*) function f05()
  45   dimension :: f05(1) ! C723
  46   f05(1) = ''
  47 end function
  48
  49 !ERROR: An assumed-length CHARACTER(*) function cannot return an array
  50 function f06()
  51   character(*) :: f06(1) ! C723
  52   f06(1) = ''
  53 end function
  54
  55 !ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
  56 character(*) function f07()
  57   pointer :: f07 ! C723
  58   character, target :: a = ' '
  59   f07 => a
  60 end function
  61
  62 !ERROR: An assumed-length CHARACTER(*) function cannot return a POINTER
  63 function f08()
  64   character(*), pointer :: f08 ! C723
  65   character, target :: a = ' '
  66   f08 => a
  67 end function
  68
  69 !ERROR: An assumed-length CHARACTER(*) function cannot be PURE
  70 pure character(*) function f09() ! C723
  71   f09 = ''
  72 end function
  73
  74 !ERROR: An assumed-length CHARACTER(*) function cannot be PURE
  75 pure function f10()
  76   character(*) :: f10 ! C723
  77   f10 = ''
  78 end function
  79
  80 !ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
  81 elemental character(*) function f11(n) ! C723
  82   integer, value :: n
  83   f11 = ''
  84 end function
  85
  86 !ERROR: An assumed-length CHARACTER(*) function cannot be ELEMENTAL
  87 elemental function f12(n)
  88   character(*) :: f12 ! C723
  89   integer, value :: n
  90   f12 = ''
  91 end function
  92
  93 function f13(n) result(res)
  94   integer, value :: n
  95   character(*) :: res
  96   if (n <= 0) then
  97     res = ''
  98   else
  99     !ERROR: Assumed-length CHARACTER(*) function 'f13' cannot call itself
 100     !ERROR: Assumed-length character function must be defined with a length to be called
 101     res = f13(n-1) ! 15.6.2.1(3)
 102   end if
 103 end function
 104
 105 function f14(n) result(res)
 106   integer, value :: n
 107   character(*) :: res
 108   if (n <= 0) then
 109     res = ''
 110   else
 111     res = nested()
 112   end if
 113  contains
 114   character(1) function nested()
 115     !ERROR: Assumed-length CHARACTER(*) function 'f14' cannot call itself
 116     !ERROR: Assumed-length character function must be defined with a length to be called
 117     nested = f14(n-1) ! 15.6.2.1(3)
 118   end function nested
 119 end function
 120
 121 subroutine s01(f1, f2, fp1, fp2, fp3)
 122   !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
 123   character*(*) :: f1, f3, fp1
 124   external :: f1, f3
 125   pointer :: fp1, fp3
 126   !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
 127   procedure(character*(*)), pointer :: fp2
 128   interface
 129     character*(*) function f2()
 130     end function
 131     !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
 132     character*(*) function fp3()
 133     end function
 134     !ERROR: A function interface may not declare an assumed-length CHARACTER(*) result
 135     character*(*) function f4()
 136     end function
 137   end interface
 138   print *, f1()
 139   print *, f2()
 140   !ERROR: Assumed-length character function must be defined with a length to be called
 141   print *, f3()
 142   print *, fp1()
 143   print *, fp2()
 144 end subroutine