gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/67277 - ISHFTC and missing optional argument SIZE
   4
   5 module m
   6   implicit none
   7 contains
   8   ! Optional argument passed by reference
   9   elemental function ishftc4_ref (i, shift, size_) result(r)
  10     integer(4), intent(in)           :: i
  11     integer,    intent(in)           :: shift
  12     integer,    intent(in), optional :: size_
  13     integer                          :: r
  14     r = ishftc (i, shift=shift, size=size_)
  15   end
  16
  17   elemental function ishftc1_ref (i, shift, size_) result(r)
  18     integer(1), intent(in)           :: i
  19     integer,    intent(in)           :: shift
  20     integer(1), intent(in), optional :: size_
  21     integer(1)                       :: r
  22     r = ishftc (i, shift=shift, size=size_)
  23   end
  24
  25   ! Array valued argument i
  26   function ishftc4_ref_4 (i, shift, size_) result(r)
  27     integer(4), intent(in)           :: i(4)
  28     integer,    intent(in)           :: shift
  29     integer,    intent(in), optional :: size_
  30     integer                          :: r(size(i))
  31     r = ishftc (i, shift=shift, size=size_)
  32   end
  33
  34   ! Optional argument passed by value
  35   elemental function ishftc4_val (i, shift, size_) result(r)
  36     integer(4), intent(in)           :: i
  37     integer,    intent(in)           :: shift
  38     integer,    value,      optional :: size_
  39     integer                          :: r
  40     r = ishftc (i, shift=shift, size=size_)
  41   end
  42
  43   elemental function ishftc1_val (i, shift, size_) result(r)
  44     integer(1), intent(in)           :: i
  45     integer,    intent(in)           :: shift
  46     integer(1), value,      optional :: size_
  47     integer(1)                       :: r
  48     r = ishftc (i, shift=shift, size=size_)
  49   end
  50
  51   ! Array valued argument i
  52   function ishftc4_val_4 (i, shift, size_) result(r)
  53     integer(4), intent(in)           :: i(4)
  54     integer,    intent(in)           :: shift
  55     integer,    value,      optional :: size_
  56     integer                          :: r(size(i))
  57     r = ishftc (i, shift=shift, size=size_)
  58   end
  59 end module m
  60
  61 program p
  62   use m
  63   implicit none
  64   integer    :: shift = 1
  65   integer(4) :: i4 = 127, j4(4), k4(4)
  66   integer(1) :: i1 = 127
  67   integer(4) :: expect4
  68   integer(1) :: expect1
  69
  70   ! Scalar variants
  71   expect4 = 2*i4
  72   if (ishftc      (i4, shift) /= expect4) stop 1
  73   if (ishftc4_ref (i4, shift) /= expect4) stop 2
  74   if (ishftc4_val (i4, shift) /= expect4) stop 3
  75
  76   expect1 = -2_1
  77   if (ishftc      (i1, shift) /= expect1) stop 4
  78   if (ishftc1_ref (i1, shift) /= expect1) stop 5
  79   if (ishftc1_val (i1, shift) /= expect1) stop 6
  80
  81   ! Array arguments
  82   expect4 = 2*i4
  83   j4 = i4
  84   k4 = ishftc        (j4, shift)
  85   if (any (k4 /= expect4)) stop 7
  86
  87   ! The following works on x86_64 but might currently fail on other systems:
  88   ! (see PR113377)
  89 ! k4 = ishftc4_val_4 (j4, shift)
  90 ! if (any (k4 /= expect4)) stop 8
  91
  92   ! The following currently segfaults (might be a scalarizer issue):
  93   ! (see PR113377)
  94 ! k4 = ishftc4_ref_4 (j4, shift)
  95 ! print *, k4
  96 ! if (any (k4 /= expect4)) stop 9
  97 end program p