Skip to content

Commit

Permalink
+ generic type bound
Browse files Browse the repository at this point in the history
  • Loading branch information
pletzer committed Dec 3, 2024
1 parent 018a9ad commit e090522
Show file tree
Hide file tree
Showing 3 changed files with 74 additions and 0 deletions.
1 change: 1 addition & 0 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ enable_language(Fortran)

enable_testing()

add_subdirectory(generic_type_bound)
add_subdirectory(specific_type_bound)
add_subdirectory(select_type)
add_subdirectory(associate)
Expand Down
22 changes: 22 additions & 0 deletions generic_type_bound/CMakeLists.txt
Original file line number Diff line number Diff line change
@@ -0,0 +1,22 @@
include_directories(
${CMAKE_CURRENT_SOURCE_DIR}
)

set(LIB_FILES
test_generic_type_bound.f90
)

set(HEADER_FILES
)

add_executable(test_generic_type_bound test_generic_type_bound.f90)

add_test(NAME test_generic_type_bound
COMMAND test_generic_type_bound)
set_tests_properties(test_generic_type_bound PROPERTIES
PASS_REGULAR_EXPRESSION "SUCCESS")


# Install headers
install(FILES ${HEADER_FILES} DESTINATION include)

51 changes: 51 additions & 0 deletions generic_type_bound/test_generic_type_bound.f90
Original file line number Diff line number Diff line change
@@ -0,0 +1,51 @@
module line_mod

type line_type
real :: pt1(2)
real :: pt2(2)
contains
procedure :: sc => scale
procedure :: tr => translate
generic :: modify => sc, tr
procedure :: show => show_line
end type line_type

contains

subroutine show_line(this)
class(line_type), intent(in) :: this
print *, 'Line ', this%pt1, ' -> ', this%pt2
end subroutine show_line

function scale(this, factor) result(res)
class(line_type), intent(in) :: this
real, intent(in) :: factor
type(line_type) :: res
res%pt1 = this%pt1 * factor
res%pt2 = this%pt2 * factor
end function scale

function translate(this, disp) result(res)
class(line_type), intent(in) :: this
real, intent(in) :: disp(2)
type(line_type) :: res
res%pt1 = this%pt1 + disp
res%pt2 = this%pt2 + disp
end function translate

end module line_mod

program test
use line_mod
implicit none
type(line_type) :: line, new_line, new_line2
line%pt1 = [0.0, 1.0]
line%pt2 = [2.0, 3.0]
! scale
new_line = line%modify(2.0)
! new
new_line2 = new_line%modify([4.0, 5.0])
call new_line%show()
call new_line2%show()
print *, 'SUCCESS'
end program test

0 comments on commit e090522

Please sign in to comment.