gcc/testsuite/gfortran.dg/typebound_operator_20.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 63733: [4.8/4.9/5 Regression] [OOP] wrong resolution for OPERATOR generics
   4 !
   5 ! Original test case from Alberto F. Martín Huertas <amartin@cimne.upc.edu>
   6 ! Slightly modified by Salvatore Filippone <sfilippone@uniroma2.it>
   7 ! Further modified by Janus Weil <janus@gcc.gnu.org>
   8
   9 module overwrite
  10   type parent
  11    contains
  12      procedure :: sum => sum_parent
  13      generic   :: operator(+) => sum
  14   end type
  15
  16   type, extends(parent) ::  child
  17   contains
  18     procedure :: sum => sum_child
  19   end type
  20
  21 contains
  22
  23   integer function sum_parent(op1,op2)
  24     implicit none
  25     class(parent), intent(in) :: op1, op2
  26     sum_parent = 0
  27   end function
  28
  29   integer function sum_child(op1,op2)
  30     implicit none
  31     class(child) , intent(in) :: op1
  32     class(parent), intent(in) :: op2
  33     sum_child = 1
  34   end function
  35
  36 end module
  37
  38 program drive
  39   use overwrite
  40   implicit none
  41
  42   type(parent) :: m1, m2
  43   class(parent), pointer :: mres
  44   type(child)  :: h1, h2
  45   class(parent), pointer :: hres
  46
  47   if (m1 + m2 /= 0) STOP 1
  48   if (h1 + m2 /= 1) STOP 2
  49   if (h1%sum(h2) /= 1) STOP 3
  50
  51 end