flang/test/Semantics/get_team.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Check for semantic errors in get_team(), as defined in
   3 ! section 16.9.85 of the Fortran 2018 standard
   4
   5 program get_team_test
   6   use iso_fortran_env, only: team_type, initial_team, current_team, parent_team
   7   implicit none
   8
   9   integer n, array(1), coarray[*]
  10   type(team_type) :: result_team
  11   logical wrong_result_type, non_integer
  12
  13   !___ standard-conforming statement with no optional arguments present ___
  14   result_team = get_team()
  15
  16   !___ standard-conforming statements with optional level argument present ___
  17   result_team = get_team(-1)
  18   result_team = get_team(-2)
  19   result_team = get_team(-3)
  20   result_team = get_team(initial_team)
  21   result_team = get_team(current_team)
  22   result_team = get_team(parent_team)
  23   result_team = get_team(n)
  24   result_team = get_team(array(1))
  25   result_team = get_team(array(n))
  26   result_team = get_team(coarray[1])
  27   result_team = get_team(level=initial_team)
  28   result_team = get_team(level=n)
  29
  30   !___ non-conforming statements ___
  31   !ERROR: 'level=' argument has unacceptable rank 1
  32   result_team = get_team(array)
  33
  34   !ERROR: Actual argument for 'level=' has bad type 'LOGICAL(4)'
  35   result_team = get_team(non_integer)
  36
  37   !ERROR: Actual argument for 'level=' has bad type 'REAL(4)'
  38   result_team = get_team(3.4)
  39
  40   !ERROR: too many actual arguments for intrinsic 'get_team'
  41   result_team = get_team(current_team, parent_team)
  42
  43   !ERROR: Actual argument for 'level=' has bad type 'REAL(4)'
  44   result_team = get_team(level=3.4)
  45
  46   !ERROR: unknown keyword argument to intrinsic 'get_team'
  47   result_team = get_team(levels=initial_team)
  48
  49   !ERROR: repeated keyword argument to intrinsic 'get_team'
  50   result_team = get_team(level=initial_team, level=parent_team)
  51
  52   !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types LOGICAL(4) and TYPE(__builtin_team_type)
  53   wrong_result_type = get_team()
  54
  55 end program get_team_test