gcc/testsuite/gfortran.dg/class_40.f03

   1 ! { dg-do run }
   2 !
   3 ! PR 47767: [OOP] SELECT TYPE fails to execute correct TYPE IS block
   4 !
   5 ! Contributed by Andrew Benson <abenson@caltech.edu>
   6
   7 module Tree_Nodes
   8   type treeNode
   9    contains
  10      procedure :: walk
  11   end type
  12 contains
  13   subroutine walk (thisNode)
  14     class (treeNode) :: thisNode
  15     print *, SAME_TYPE_AS (thisNode, treeNode())
  16   end subroutine
  17 end module
  18
  19 module Merger_Trees
  20   use Tree_Nodes
  21   private
  22   type(treeNode), public :: baseNode
  23 end module
  24
  25 module Merger_Tree_Build
  26   use Merger_Trees
  27 end module
  28
  29 program test
  30   use Merger_Tree_Build
  31   use Tree_Nodes
  32   type(treeNode) :: node
  33   call walk (node)
  34 end program
  35
  36 ! { dg-final { cleanup-modules "Tree_Nodes Merger_Trees Merger_Tree_Build" } }