+ specific type bound

CMakeLists.txt

@@ -12,6 +12,7 @@ enable_language(Fortran)
 
 enable_testing()
 
+add_subdirectory(specific_type_bound)
 add_subdirectory(select_type)
 add_subdirectory(associate)
 add_subdirectory(unlimited_poly)

specific_type_bound/CMakeLists.txt

@@ -0,0 +1,22 @@
+include_directories(
+  ${CMAKE_CURRENT_SOURCE_DIR}
+  )
+
+set(LIB_FILES
+  test_specific_type_bound.f90
+)
+
+set(HEADER_FILES
+)
+
+add_executable(test_specific_type_bound test_specific_type_bound.f90)
+
+add_test(NAME test_specific_type_bound
+         COMMAND test_specific_type_bound)
+set_tests_properties(test_specific_type_bound PROPERTIES
+                     PASS_REGULAR_EXPRESSION "Rectangle area:")
+
+
+# Install headers
+install(FILES ${HEADER_FILES} DESTINATION include)
+

specific_type_bound/test_specific_type_bound.f90

@@ -0,0 +1,44 @@
+module shapes_module
+  implicit none
+
+  ! Define a derived type for a rectangle
+  type :: rectangle
+    real :: length, width
+  contains
+    procedure :: set_dimensions
+    procedure :: get_area
+  end type rectangle
+
+contains
+
+  ! Type-bound procedure to set the dimensions of the rectangle
+  subroutine set_dimensions(self, l, w)
+    class(rectangle), intent(inout) :: self
+    real, intent(in) :: l, w
+    self%length = l
+    self%width = w
+  end subroutine set_dimensions
+
+  ! Type-bound procedure to get the area of the rectangle
+  function get_area(self) result(area)
+    class(rectangle), intent(in) :: self
+    real :: area
+    area = self%length * self%width
+  end function get_area
+
+end module shapes_module
+
+program test_type_bound_procedure
+  use shapes_module
+  implicit none
+
+  ! Declare a variable of type rectangle
+  type(rectangle) :: r
+
+  ! Set the dimensions of the rectangle
+  call r%set_dimensions(4.0, 6.0)
+
+  ! Get and print the area of the rectangle
+  print *, "Rectangle area: ", r%get_area()
+
+end program test_type_bound_procedure