Skip to content

Commit d2985b3

Browse files
sethrjsethrj
committed
Move example functions into a separate module
1 parent 0e1dd54 commit d2985b3

File tree

4 files changed

+137
-102
lines changed

4 files changed

+137
-102
lines changed

‎example/CMakeLists.txt

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -11,11 +11,28 @@ macro(swig_fortran_add_example name)
1111
target_link_libraries(${name}.exe ${ARGN})
1212
endmacro()
1313

14+
#---------------------------------------------------------------------------##
15+
# TEST LIBRARIES
16+
#---------------------------------------------------------------------------##
17+
18+
add_library(example_utils_lib
19+
"example_utils.f90"
20+
)
21+
target_link_libraries(example_utils_lib flc flc_string flc_vector)
22+
23+
#---------------------------------------------------------------------------##
24+
# EXAMPLES
25+
#---------------------------------------------------------------------------##
26+
1427
swig_fortran_add_example(sort
15-
flc_algorithm flc_random flc_string)
28+
flc_algorithm flc_random flc_string example_utils_lib)
1629

1730
swig_fortran_add_example(vecstr
18-
flc_string flc_vector)
31+
flc_string flc_vector example_utils_lib)
32+
33+
#---------------------------------------------------------------------------##
34+
# TESTS
35+
#---------------------------------------------------------------------------##
1936

2037
if (BUILD_TESTING)
2138
add_test(

‎example/example_utils.f90

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
!-----------------------------------------------------------------------------!
2+
! \file example/example_utils.f90
3+
! \brief example_utils module
4+
! \note Copyright (c) 2019 Oak Ridge National Laboratory, UT-Battelle, LLC.
5+
!-----------------------------------------------------------------------------!
6+
7+
module example_utils
8+
use, intrinsic :: ISO_FORTRAN_ENV
9+
use, intrinsic :: ISO_C_BINDING
10+
implicit none
11+
integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT
12+
public
13+
14+
contains
15+
16+
subroutine write_version()
17+
use flc
18+
implicit none
19+
! Print version information
20+
write(STDOUT, "(a)") "========================================"
21+
write(STDOUT, "(a, a)") "Flibcpp version: ", get_flibcpp_version()
22+
write(STDOUT, "(a, 2(i1,'.'), (i1), a)") "(Numeric version: ", &
23+
flibcpp_version_major, flibcpp_version_minor, flibcpp_version_patch, &
24+
")"
25+
write(STDOUT, "(a)") "========================================"
26+
end subroutine
27+
28+
! Loop until the user inputs a positive integer. Catch error conditions.
29+
function read_positive_int(desc) result(result_int)
30+
use flc
31+
use flc_string, only : stoi
32+
implicit none
33+
character(len=*), intent(in) :: desc
34+
character(len=80) :: readstr
35+
integer :: result_int, io_ierr
36+
do
37+
write(STDOUT, *) "Enter " // desc // ": "
38+
read(STDIN, "(a)", iostat=io_ierr) readstr
39+
if (io_ierr == IOSTAT_END) then
40+
! Error condition: ctrl-D during input
41+
write(STDOUT, *) "User terminated"
42+
stop 1
43+
endif
44+
45+
result_int = stoi(readstr)
46+
if (ierr == 0) then
47+
if (result_int <= 0) then
48+
! Error condition: non-positive value
49+
write(STDOUT, *) "Invalid " // desc // ": ", result_int
50+
continue
51+
end if
52+
53+
write(STDOUT, *) "Read " // desc // "=", result_int
54+
exit
55+
endif
56+
57+
if (ierr == SWIG_OVERFLOWERROR) then
58+
! Error condition: integer doesn't fit in native integer
59+
write(STDOUT,*) "Your integer is too darn big!"
60+
else if (ierr == SWIG_VALUEERROR) then
61+
! Error condition: not an integer at all
62+
write(STDOUT,*) "That text you entered? It wasn't an integer."
63+
else
64+
write(STDOUT,*) "Unknown error", ierr
65+
end if
66+
write(STDOUT,*) "(Detailed error message: ", get_serr(), ")"
67+
68+
! Clear error flag so the next call to stoi succeeds
69+
ierr = 0
70+
end do
71+
end function
72+
73+
! Loop until the user inputs a positive integer. Catch error conditions.
74+
subroutine read_strings(vec)
75+
use flc
76+
use flc_string, only : String
77+
use flc_vector, only : VectorString
78+
use ISO_FORTRAN_ENV
79+
implicit none
80+
type(VectorString), intent(out) :: vec
81+
integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT
82+
character(len=80) :: readstr
83+
integer :: io_ierr
84+
type(String) :: str
85+
86+
! Allocate the vector
87+
vec = VectorString()
88+
89+
do
90+
! Request and read a string
91+
write(STDOUT, "(a, i3, a)") "Enter string #", vec%size() + 1, &
92+
" or Ctrl-D/empty string to complete"
93+
read(STDIN, "(a)", iostat=io_ierr) readstr
94+
if (io_ierr == IOSTAT_END) then
95+
! Break out of loop on ^D (EOF)
96+
exit
97+
end if
98+
99+
! Add string to the end of the vector
100+
call vec%push_back(trim(readstr))
101+
! Get a String object reference to the back to check if it's empty
102+
str = vec%back_ref()
103+
if (str%empty()) then
104+
! Remove the empty string
105+
call vec%pop_back()
106+
exit
107+
end if
108+
end do
109+
end subroutine
110+
111+
end module
112+
113+
!-----------------------------------------------------------------------------!
114+
! end of example/example_utils.f90
115+
!-----------------------------------------------------------------------------!

‎example/sort.f90

Lines changed: 2 additions & 60 deletions
Original file line numberDiff line numberDiff line change
@@ -5,25 +5,19 @@
55
!-----------------------------------------------------------------------------!
66

77
program sort_example
8-
use, intrinsic :: ISO_FORTRAN_ENV
98
use, intrinsic :: ISO_C_BINDING
109
use flc
1110
use flc_algorithm, only : sort
1211
use flc_random, only : Engine, normal_distribution
12+
use example_utils, only : write_version, read_positive_int, STDOUT
1313
implicit none
14-
integer, parameter :: STDOUT = OUTPUT_UNIT
1514
integer :: arr_size
1615
real(c_double), dimension(:), allocatable :: x
1716
real(c_double), parameter :: MEAN = 1.0d0, SIGMA = 0.5d0
1817
type(Engine) :: rng
1918

2019
! Print version information
21-
write(STDOUT, "(a)") "========================================"
22-
write(STDOUT, "(a, a)") "Flibcpp version: ", get_flibcpp_version()
23-
write(STDOUT, "(a, 2(i1,'.'), (i1), a)") "(Numeric version: ", &
24-
flibcpp_version_major, flibcpp_version_minor, flibcpp_version_patch, &
25-
")"
26-
write(STDOUT, "(a)") "========================================"
20+
call write_version()
2721

2822
! Get array size
2923
arr_size = read_positive_int("array size")
@@ -40,58 +34,6 @@ program sort_example
4034
write(STDOUT, "(a, 4(f8.3,','))") "First few elements:", x(:min(4, size(x)))
4135

4236
call rng%release()
43-
44-
! Valgrind fails without deallocating the array, but technically it's not
45-
! necessary in Fortran to do this
46-
deallocate(x)
47-
contains
48-
49-
! Loop until the user inputs a positive integer. Catch error conditions.
50-
function read_positive_int(desc) result(result_int)
51-
use flc
52-
use flc_string, only : stoi
53-
use ISO_FORTRAN_ENV
54-
implicit none
55-
character(len=*), intent(in) :: desc
56-
integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT
57-
character(len=80) :: readstr
58-
integer :: result_int, io_ierr
59-
do
60-
write(STDOUT, *) "Enter " // desc // ": "
61-
read(STDIN, "(a)", iostat=io_ierr) readstr
62-
if (io_ierr == IOSTAT_END) then
63-
! Error condition: ctrl-D during input
64-
write(STDOUT, *) "User terminated"
65-
stop 1
66-
endif
67-
68-
result_int = stoi(readstr)
69-
if (ierr == 0) then
70-
if (result_int <= 0) then
71-
! Error condition: non-positive value
72-
write(STDOUT, *) "Invalid " // desc // ": ", result_int
73-
continue
74-
end if
75-
76-
write(STDOUT, *) "Read " // desc // "=", result_int
77-
exit
78-
endif
79-
80-
if (ierr == SWIG_OVERFLOWERROR) then
81-
! Error condition: integer doesn't fit in native integer
82-
write(STDOUT,*) "Your integer is too darn big!"
83-
else if (ierr == SWIG_VALUEERROR) then
84-
! Error condition: not an integer at all
85-
write(STDOUT,*) "That text you entered? It wasn't an integer."
86-
else
87-
write(STDOUT,*) "Unknown error", ierr
88-
end if
89-
write(STDOUT,*) "(Detailed error message: ", get_serr(), ")"
90-
91-
! Clear error flag so the next call to stoi succeeds
92-
ierr = 0
93-
end do
94-
end function
9537
end program
9638

9739
!-----------------------------------------------------------------------------!

‎example/vecstr.f90

Lines changed: 1 addition & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -5,13 +5,12 @@
55
!-----------------------------------------------------------------------------!
66

77
program vecstr_example
8-
use, intrinsic :: ISO_FORTRAN_ENV
98
use, intrinsic :: ISO_C_BINDING
109
use flc
1110
use flc_string, only : String
1211
use flc_vector, only : VectorString
12+
use example_utils, only : read_strings, STDOUT
1313
implicit none
14-
integer, parameter :: STDOUT = OUTPUT_UNIT
1514
integer :: i
1615
type(VectorString) :: vec
1716
type(String) :: back, front
@@ -68,44 +67,6 @@ program vecstr_example
6867

6968
! Free allocated vector memory
7069
call vec%release()
71-
contains
72-
73-
! Loop until the user inputs a positive integer. Catch error conditions.
74-
subroutine read_strings(vec)
75-
use flc
76-
use flc_string, only : stoi
77-
use ISO_FORTRAN_ENV
78-
implicit none
79-
type(VectorString), intent(out) :: vec
80-
integer, parameter :: STDOUT = OUTPUT_UNIT, STDIN = INPUT_UNIT
81-
character(len=80) :: readstr
82-
integer :: io_ierr
83-
type(String) :: str
84-
85-
! Allocate the vector
86-
vec = VectorString()
87-
88-
do
89-
! Request and read a string
90-
write(STDOUT, "(a, i3, a)") "Enter string #", vec%size() + 1, &
91-
" or Ctrl-D/empty string to complete"
92-
read(STDIN, "(a)", iostat=io_ierr) readstr
93-
if (io_ierr == IOSTAT_END) then
94-
! Break out of loop on ^D (EOF)
95-
exit
96-
end if
97-
98-
! Add string to the end of the vector
99-
call vec%push_back(trim(readstr))
100-
! Get a String object reference to the back to check if it's empty
101-
str = vec%back_ref()
102-
if (str%empty()) then
103-
! Remove the empty string
104-
call vec%pop_back()
105-
exit
106-
end if
107-
end do
108-
end subroutine
10970
end program
11071

11172
!-----------------------------------------------------------------------------!

0 commit comments

Comments
 (0)