gcc/testsuite/gfortran.dg/operator_1.f90

   1 ! { dg-do run }
   2 ! Test the extension of intrinsic operators
   3 module m1
   4  interface operator(*)
   5   module procedure f1
   6   module procedure f2
   7   module procedure f3
   8  end interface
   9
  10  interface operator(.or.)
  11   module procedure g1
  12  end interface
  13
  14  interface operator(//)
  15   module procedure g1
  16  end interface
  17
  18 contains
  19
  20  function f1(a,b) result (c)
  21   integer, dimension(2,2), intent(in) :: a
  22   integer, dimension(2), intent(in)   :: b
  23   integer, dimension(2)   :: c
  24   c = matmul(a,b)
  25  end function f1
  26  function f2(a,b) result (c)
  27   real, dimension(2,2), intent(in) :: a
  28   real, dimension(2), intent(in)   :: b
  29   real, dimension(2)   :: c
  30   c = matmul(a,b)
  31  end function f2
  32  function f3(a,b) result (c)
  33   complex, dimension(2,2), intent(in) :: a
  34   complex, dimension(2), intent(in)   :: b
  35   complex, dimension(2)   :: c
  36   c = matmul(a,b)
  37  end function f3
  38
  39  elemental function g1(a,b) result (c)
  40    integer, intent(in) :: a, b
  41    integer :: c
  42    c = a + b
  43  end function g1
  44
  45 end module m1
  46
  47   use m1
  48   implicit none
  49
  50   integer, dimension(2,2) :: ai
  51   integer, dimension(2)   :: bi, ci
  52   real, dimension(2,2) :: ar
  53   real, dimension(2)   :: br, cr
  54   complex, dimension(2,2) :: ac
  55   complex, dimension(2)   :: bc, cc
  56
  57   ai = reshape((/-2,-4,7,8/),(/2,2/)) ; bi = 3
  58   if (any((ai*bi) /= matmul(ai,bi))) call abort()
  59   if (any((ai .or. ai) /= ai+ai)) call abort()
  60   if (any((ai // ai) /= ai+ai)) call abort()
  61
  62   ar = reshape((/-2,-4,7,8/),(/2,2/)) ; br = 3
  63   if (any((ar*br) /= matmul(ar,br))) call abort()
  64
  65   ac = reshape((/-2,-4,7,8/),(/2,2/)) ; bc = 3
  66   if (any((ac*bc) /= matmul(ac,bc))) call abort()
  67
  68 end
  69 ! { dg-final { cleanup-modules "m1" } }