[Bug fortran/48894] New: generic omp_get_ancestor_thread_num(l(i)) produces incorrect output

[longb at cray dot com]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48894

           Summary: generic omp_get_ancestor_thread_num(l(i)) produces
                    incorrect output
           Product: gcc
           Version: 4.5.3
            Status: UNCONFIRMED
          Severity: minor
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: longb@cray.com


I wavered between "minor" and "trivial" on this one, but the OpenMP testers
came up with this end case.  It seems very unlikely to arise in a real program,
but is also probably easy to fix in the library code.

> cat test1.f90
!  derived from OpenMP test OMP3f/F03_3_2_17_1a.F90
!  See - OpenMP 3.0 API spec, p. 131, lines 2-9.
program F03_3_2_17_1a
   use omp_lib
   implicit none

   logical, parameter :: FALSE=.false.
   logical, parameter :: TRUE=.true.
   integer, parameter :: ZERO=0
   integer, parameter :: TWO=2
   integer*4, parameter :: ZERO4=0
   integer, parameter :: MHUGE4=-huge(ZERO4)
   integer :: level(10) =            &
     (/-huge(ZERO), -huge(ZERO)+3, MHUGE4, -1, 0, 1, 2, 3, 4, huge(ZERO)/)

   integer :: i
   integer, dimension(10) :: expected_ancestor_thread_num,        &
                       actual_ancestor_thread_num = (/(-huge(i), i=1,10)/)

   call omp_set_dynamic( FALSE )
   call omp_set_nested( TRUE )
   call omp_set_max_active_levels(TWO) ! one inactive parallel region

   ! if the implementation supports nested parallelism, then expected value of
   ! omp_get_ancestor_thread(2) == 1, else 0
   if (omp_get_nested()) then
      expected_ancestor_thread_num = (/-1, -1, -1, -1, 0, 2, 1, 0, -1, -1/)
   else
      expected_ancestor_thread_num = (/-1, -1, -1, -1, 0, 2, 0, 0, -1, -1/)
   end if

   !$omp parallel num_threads(3)    ! nest level 1
   if (omp_get_thread_num() == 2) then ! ancestor thread num = 2 at this level
      !$omp parallel num_threads(2) ! nest level 2
      if ((omp_get_nested() .and. omp_get_thread_num() == 1) .or. &
          (omp_get_nested() .eqv. .false. .and. omp_get_thread_num() == 0))
then
         !$omp parallel             ! nest level 3
         ! inactive parallel region due to max-active-level-var == 2,
         ! so should be executed by only one thread
         do i = 1, size(level)
            actual_ancestor_thread_num(i)
=omp_get_ancestor_thread_num(level(i))
         end do
         !$omp end parallel
      end if 
      !$omp end parallel
   end if
   !$omp end parallel

   do i = 1, size(level)
       print *, 'level(i)=', level(i)
      if (actual_ancestor_thread_num(i) /= expected_ancestor_thread_num(i))
then
         print *, "FAIL - omp_get_ancestor_thread_num(", level(i), ")", &
                  " == ", actual_ancestor_thread_num(i), " (expected ", & 
                  expected_ancestor_thread_num(i), ")"
      end if 
   end do

end program F03_3_2_17_1a

> gfortran -fopenmp -fdefault-integer-8 -fdefault-real-8 test1.f90
> ./a.out 
level(i)= -9223372036854775807
 FAIL - omp_get_ancestor_thread_num( -9223372036854775807 ) ==                 
   2  (expected                    -1 )
 level(i)= -9223372036854775804
 level(i)=          -2147483647
 level(i)=                   -1
 level(i)=                    0
 level(i)=                    1
 level(i)=                    2
 level(i)=                    3
 level(i)=                    4
 level(i)=  9223372036854775807
> 


>From the OpenMP spec from page 131, lines 2-5:

"The omp_get_ancestor_thread_num routine returns the thread number of the
ancestor at a given nest level of the current thread or the thread number of
the current thread. If the requested nest level is outside the range of 0 and
the nest level of the current thread, as returned by the omp_get_level routine,
the routine returns -1."

The routine omp_get_level() always returns a result that is 0 or a positive
integer. So any negative argument to omp_get_ancestor_thread_num that is
negative is outside the range 0..omp_get_level(), so the result should be -1.

I suspect what is happening here is that the computation inside
omp_get_ancestor_thread_num (n) involves a subtract of n - num_threads which
wraps around because the value of n is at the limit of representable integers.
Note that the second trial input is different by 3 (and num_threads is 3), so
it just barely avoids the wrap.