gcc/testsuite/gfortran.dg/minmaxloc_8.f90

   1 ! { dg-do  run }
   2 ! { dg-options "-fdump-tree-original" }
   3 ! Test that minloc and maxloc using KINDs return the right
   4 ! kind, by using unformatted I/O for a specific kind.
   5 program main
   6   implicit none
   7   real, dimension(3) :: a
   8   integer :: r1, r2, r4, r8
   9   integer :: k
  10   character(len=30) :: l1, l2
  11
  12   ! Check via I/O if the KIND is used correctly
  13   a = [ 1.0, 3.0, 2.0]
  14   write (unit=l1,fmt=*) 2_1
  15   write (unit=l2,fmt=*) maxloc(a,kind=1)
  16   if (l1 /= l2) call abort
  17
  18   write (unit=l1,fmt=*) 2_2
  19   write (unit=l2,fmt=*) maxloc(a,kind=2)
  20   if (l1 /= l2) call abort
  21
  22   write (unit=l1,fmt=*) 2_4
  23   write (unit=l2,fmt=*) maxloc(a,kind=4)
  24   if (l1 /= l2) call abort
  25
  26   write (unit=l1,fmt=*) 2_8
  27   write (unit=l2,fmt=*) maxloc(a,kind=8)
  28   if (l1 /= l2) call abort
  29
  30   a = [ 3.0, -1.0, 2.0]
  31
  32   write (unit=l1,fmt=*) 2_1
  33   write (unit=l2,fmt=*) minloc(a,kind=1)
  34   if (l1 /= l2) call abort
  35
  36   write (unit=l1,fmt=*) 2_2
  37   write (unit=l2,fmt=*) minloc(a,kind=2)
  38   if (l1 /= l2) call abort
  39
  40   write (unit=l1,fmt=*) 2_4
  41   write (unit=l2,fmt=*) minloc(a,kind=4)
  42   if (l1 /= l2) call abort
  43
  44   write (unit=l1,fmt=*) 2_8
  45   write (unit=l2,fmt=*) minloc(a,kind=8)
  46   if (l1 /= l2) call abort
  47
  48 end program main