gcc/testsuite/gfortran.dg/intrinsic_sign_2.f90

   1 ! { dg-do run }
   2 ! Testcase for SIGN() with integer arguments
   3 ! Check that:
   4 !   + SIGN() evaluates its arguments only once
   5 !   + SIGN() works on large values
   6 !   + SIGN() works with parameter arguments
   7 ! Contributed by FX Coudert <fxcoudert@gmail.com>
   8 program sign1
   9   implicit none
  10   integer(kind=1), parameter :: one1 = 1_1, mone1 = -1_1
  11   integer(kind=2), parameter :: one2 = 1_2, mone2 = -1_2
  12   integer(kind=4), parameter :: one4 = 1_4, mone4 = -1_4
  13   integer(kind=8), parameter :: one8 = 1_8, mone8 = -1_8
  14   integer(kind=1) :: i1, j1
  15   integer(kind=2) :: i2, j2
  16   integer(kind=4) :: i4, j4
  17   integer(kind=8) :: i8, j8
  18   integer :: i = 1
  19
  20   i1 = huge(0_1) ; j1 = -huge(0_1)
  21   if (sign(i1, j1) /= j1) STOP 1
  22   if (sign(j1, i1) /= i1) STOP 2
  23   if (sign(i1,one1) /= i1 .or. sign(j1,one1) /= i1) STOP 3
  24   if (sign(i1,mone1) /= j1 .or. sign(j1,mone1) /= j1) STOP 4
  25
  26   i2 = huge(0_2) ; j2 = -huge(0_2)
  27   if (sign(i2, j2) /= j2) STOP 5
  28   if (sign(j2, i2) /= i2) STOP 6
  29   if (sign(i2,one2) /= i2 .or. sign(j2,one2) /= i2) STOP 7
  30   if (sign(i2,mone2) /= j2 .or. sign(j2,mone2) /= j2) STOP 8
  31
  32   i4 = huge(0_4) ; j4 = -huge(0_4)
  33   if (sign(i4, j4) /= j4) STOP 9
  34   if (sign(j4, i4) /= i4) STOP 10
  35   if (sign(i4,one4) /= i4 .or. sign(j4,one4) /= i4) STOP 11
  36   if (sign(i4,mone4) /= j4 .or. sign(j4,mone4) /= j4) STOP 12
  37
  38   i8 = huge(0_8) ; j8 = -huge(0_8)
  39   if (sign(i8, j8) /= j8) STOP 13
  40   if (sign(j8, i8) /= i8) STOP 14
  41   if (sign(i8,one8) /= i8 .or. sign(j8,one8) /= i8) STOP 15
  42   if (sign(i8,mone8) /= j8 .or. sign(j8,mone8) /= j8) STOP 16
  43
  44   if (sign(foo(i), 1) /= 1) STOP 1
  45   if (sign(foo(i), -1) /= -2) STOP 2
  46   if (sign(42, foo(i)) /= 42) STOP 3
  47   if (sign(42, -foo(i)) /= -42) STOP 4
  48   if (i /= 5) STOP 5
  49
  50   if (sign(bar(), 1) /= 1) STOP 6
  51   if (sign(bar(), -1) /= -2) STOP 7
  52   if (sign(17, bar()) /= 17) STOP 8
  53   if (sign(17, -bar()) /= -17) STOP 9
  54   if (bar() /= 5) STOP 10
  55
  56 contains
  57
  58   integer function foo(i)
  59     integer :: i
  60     foo = i
  61     i = i + 1
  62   end function
  63
  64   integer function bar()
  65     integer, save :: i = 0
  66     i = i + 1
  67     bar = i
  68   end function
  69 end