Skip to content

Commit 0627ec8

Browse files
marvinfriedemarvinfriede
authored
Command line option for functional listing (#219)
* Add command line option for functional listing * Update command line interface and improve functional listing * Remove old version * Fix copy-paste error * Add simple execution test * Fix missing parameter references * Adapt docs * Refactor and remove unsupported functionals
1 parent 3844dc1 commit 0627ec8

8 files changed

Lines changed: 908 additions & 251 deletions

File tree

‎app/CMakeLists.txt‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,10 @@
1717
add_executable(
1818
"${PROJECT_NAME}-exe"
1919
"main.f90"
20+
"argument.f90"
2021
"cli.f90"
2122
"driver.f90"
23+
"help.f90"
2224
)
2325
set_target_properties(
2426
"${PROJECT_NAME}-exe"

‎app/argument.f90‎

Lines changed: 364 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,364 @@
1+
! This file is part of dftd4.
2+
! SPDX-Identifier: LGPL-3.0-or-later
3+
!
4+
! dftd4 is free software: you can redistribute it and/or modify it under
5+
! the terms of the Lesser GNU General Public License as published by
6+
! the Free Software Foundation, either version 3 of the License, or
7+
! (at your option) any later version.
8+
!
9+
! dftd4 is distributed in the hope that it will be useful,
10+
! but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
! Lesser GNU General Public License for more details.
13+
!
14+
! You should have received a copy of the Lesser GNU General Public License
15+
! along with dftd4. If not, see <https://www.gnu.org/licenses/>.
16+
17+
!> Implementation of the argument list processor.
18+
module dftd4_argument
19+
implicit none
20+
private
21+
22+
public :: argument_list, len
23+
public :: argument_count_interface, get_argument_interface
24+
25+
26+
!> Internal representation of the command line arguments
27+
type :: argument
28+
private
29+
!> Actual payload of the argument
30+
character(len=:), allocatable :: raw
31+
end type argument
32+
33+
!> Constructor for the argument representation
34+
interface argument
35+
module procedure :: new_argument
36+
end interface argument
37+
38+
39+
!> Argument list class
40+
type :: argument_list
41+
!> Name of the invoked executable, if available
42+
character(len=:), allocatable :: prog
43+
!> Number of arguments
44+
integer :: nargs = 0
45+
!> Array of arguments in this list
46+
type(argument), allocatable :: argv(:)
47+
contains
48+
!> Append a command line argument
49+
procedure :: push_back
50+
!> Display debug information on this instance
51+
procedure :: info
52+
!> Get command line argument
53+
procedure :: get
54+
end type argument_list
55+
56+
!> Constructor for the argument list
57+
interface argument_list
58+
module procedure :: new_argument_list
59+
end interface argument_list
60+
61+
interface len
62+
module procedure :: get_length
63+
end interface len
64+
65+
66+
abstract interface
67+
!> Interface of the argument counter
68+
function argument_count_interface() result(argument_count)
69+
!> Number of available arguments
70+
integer :: argument_count
71+
end function argument_count_interface
72+
73+
!> Interface of the argument getter
74+
subroutine get_argument_interface(idx, arg)
75+
!> Index of the argument to retrieve, range 0 to argument_counter()
76+
integer, intent(in) :: idx
77+
!> Returned argument payload, allocation status is used to signal errors
78+
character(len=:), allocatable, intent(out) :: arg
79+
end subroutine get_argument_interface
80+
end interface
81+
82+
!> Token identifyin response files
83+
character(len=*), parameter :: response_token = "@"
84+
85+
!> Initial size for the resizer of the argument list
86+
integer, parameter :: initial_size = 20
87+
88+
89+
contains
90+
91+
92+
!> Create a new argument from a raw payload
93+
pure function new_argument(raw) result(new)
94+
!> Raw argument value
95+
character(len=*), intent(in) :: raw
96+
!> Representation of the argument
97+
type(argument) :: new
98+
99+
new%raw = raw
100+
end function new_argument
101+
102+
!> Constructor of the argument list
103+
function new_argument_list(argument_counter, argument_getter) result(new)
104+
!> Argument counter interface
105+
procedure(argument_count_interface), optional :: argument_counter
106+
!> Argument getter interface
107+
procedure(get_argument_interface), optional :: argument_getter
108+
!> Newly created argument list
109+
type(argument_list) :: new
110+
111+
intrinsic :: present
112+
113+
if (present(argument_getter) .and. present(argument_counter)) then
114+
call make_argument_list(new, argument_counter, argument_getter)
115+
else
116+
call make_argument_list(new, default_argument_count, get_default_argument)
117+
end if
118+
end function new_argument_list
119+
120+
!> Internal constructor of the argument list
121+
subroutine make_argument_list(self, argument_counter, argument_getter)
122+
!> Instance of the argument list to be created
123+
type(argument_list), intent(out) :: self
124+
!> Argument counter interface
125+
procedure(argument_count_interface) :: argument_counter
126+
!> Argument getter interface
127+
procedure(get_argument_interface) :: argument_getter
128+
129+
integer :: iarg, narg, info
130+
character(len=:), allocatable :: arg
131+
intrinsic :: allocated
132+
133+
info = 0
134+
narg = argument_counter()
135+
self%nargs = 0
136+
call resize(self%argv, narg)
137+
call argument_getter(0, self%prog)
138+
do iarg = 1, narg
139+
call argument_getter(iarg, arg)
140+
if (.not.allocated(arg)) return
141+
if (is_response_file(arg)) then
142+
call get_response_file(self, arg(2:), info)
143+
if (info == 0) cycle
144+
end if
145+
call push_back(self, arg)
146+
end do
147+
148+
end subroutine make_argument_list
149+
150+
151+
!> Check if an argument represents a response file
152+
pure function is_response_file(arg) result(is_resp)
153+
!> Argument of interest
154+
character(len=*), intent(in) :: arg
155+
!> Whether the argument could be a response file or not
156+
logical :: is_resp
157+
intrinsic :: len
158+
159+
if (len(arg) > 1) then
160+
is_resp = arg(1:1) == response_token
161+
else
162+
is_resp = .false.
163+
end if
164+
end function is_response_file
165+
166+
!> Recursively consume a response file and append it to the argument list
167+
recursive subroutine get_response_file(self, resp, stat)
168+
!> Instance of the argument list
169+
class(argument_list), intent(inout) :: self
170+
!> Name of the response file to be appended
171+
character(len=*), intent(in) :: resp
172+
!> Status of reading the reponse file
173+
integer, intent(out) :: stat
174+
175+
integer :: unit, info, istat
176+
logical :: opened
177+
character(len=:), allocatable :: arg
178+
179+
inquire(file=resp, opened=opened)
180+
if (opened) then
181+
stat = 1
182+
return
183+
end if
184+
185+
open(file=resp, unit=unit, iostat=info, status='old', action='read')
186+
do while(info == 0)
187+
call getline(unit, arg, info)
188+
if (info /= 0) exit
189+
if (is_response_file(arg)) then
190+
call get_response_file(self, arg(2:), istat)
191+
if (istat == 0) cycle
192+
end if
193+
call push_back(self, arg)
194+
end do
195+
close(unit, iostat=stat)
196+
if (info /= 0) then
197+
stat = merge(0, info, is_iostat_end(info))
198+
end if
199+
end subroutine get_response_file
200+
201+
!> Consume a whole line from a formatted unit
202+
subroutine getline(unit, line, iostat, iomsg)
203+
!> Formatted IO unit
204+
integer, intent(in) :: unit
205+
!> Line to read
206+
character(len=:), allocatable, intent(out) :: line
207+
!> Status of operation
208+
integer, intent(out) :: iostat
209+
!> Error message
210+
character(len=:), allocatable, optional :: iomsg
211+
212+
integer, parameter :: bufsize = 512
213+
character(len=bufsize) :: buffer, msg
214+
integer :: size, stat
215+
intrinsic :: is_iostat_eor, present, trim
216+
217+
allocate(character(len=0) :: line)
218+
do
219+
read(unit, '(a)', advance='no', iostat=stat, iomsg=msg, size=size) &
220+
& buffer
221+
if (stat > 0) exit
222+
line = line // buffer(:size)
223+
if (stat < 0) exit
224+
end do
225+
226+
if (is_iostat_eor(stat)) stat = 0
227+
228+
if (stat /= 0) then
229+
if (present(iomsg)) iomsg = trim(msg)
230+
end if
231+
iostat = stat
232+
233+
end subroutine getline
234+
235+
236+
!> Append a string to the argument list
237+
subroutine push_back(self, string)
238+
!> Instance of the argument list
239+
class(argument_list), intent(inout) :: self
240+
!> String representing the argument
241+
character(len=*), intent(in) :: string
242+
intrinsic :: size
243+
244+
self%nargs = self%nargs + 1
245+
if (self%nargs > size(self%argv)) call resize(self%argv)
246+
self%argv(self%nargs) = argument(string)
247+
248+
end subroutine push_back
249+
250+
!> Reallocate list of arguments
251+
pure subroutine resize(list, n)
252+
!> Instance of the array to be resized
253+
type(argument), allocatable, intent(inout) :: list(:)
254+
!> Dimension of the final array size
255+
integer, intent(in), optional :: n
256+
257+
type(argument), allocatable :: tmp(:)
258+
integer :: this_size, new_size, iv
259+
intrinsic :: allocated, size, move_alloc, present, min
260+
261+
if (allocated(list)) then
262+
this_size = size(list, 1)
263+
call move_alloc(list, tmp)
264+
else
265+
this_size = initial_size
266+
end if
267+
268+
if (present(n)) then
269+
new_size = n
270+
else
271+
new_size = this_size + this_size/2 + 1
272+
end if
273+
274+
allocate(list(new_size))
275+
276+
if (allocated(tmp)) then
277+
this_size = min(size(tmp, 1), size(list, 1))
278+
do iv = 1, this_size
279+
call move_alloc(tmp(iv)%raw, list(iv)%raw)
280+
end do
281+
deallocate(tmp)
282+
end if
283+
end subroutine resize
284+
285+
286+
!> Display debug information on an argument list instance
287+
subroutine info(self, unit)
288+
!> Instance of the argument list
289+
class(argument_list), intent(in) :: self
290+
!> Formatted unit for output
291+
integer, intent(in) :: unit
292+
293+
character(len=*), parameter :: fmt = '("#", *(1x, g0))'
294+
integer :: iarg
295+
intrinsic :: allocated
296+
297+
if (allocated(self%prog)) then
298+
write(unit, fmt) self%prog
299+
end if
300+
301+
if (allocated(self%argv)) then
302+
write(unit, fmt) self%nargs, "arguments provided"
303+
do iarg = 1, self%nargs
304+
write(unit, fmt) iarg, "/", self%nargs, "->", self%argv(iarg)%raw
305+
end do
306+
end if
307+
end subroutine info
308+
309+
310+
!> Default argument counter using the intrinsic command_argument_count procedure
311+
function default_argument_count() result(argument_count)
312+
!> Number of available arguments
313+
integer :: argument_count
314+
315+
intrinsic :: command_argument_count
316+
317+
argument_count = command_argument_count()
318+
end function default_argument_count
319+
320+
!> Default argument getter using the intrinsic get_command_argument procedure
321+
subroutine get_default_argument(idx, arg)
322+
!> Index of the argument to retrieve, range 0 to argument_counter()
323+
integer, intent(in) :: idx
324+
!> Returned argument payload, allocation status is used to signal errors
325+
character(len=:), allocatable, intent(out) :: arg
326+
327+
integer :: length, stat
328+
intrinsic :: get_command_argument
329+
330+
call get_command_argument(idx, length=length, status=stat)
331+
if (stat /= 0) then
332+
return
333+
endif
334+
335+
allocate(character(len=length) :: arg, stat=stat)
336+
if (stat /= 0) then
337+
return
338+
endif
339+
340+
if (length > 0) then
341+
call get_command_argument(idx, arg, status=stat)
342+
if (stat /= 0) then
343+
deallocate(arg)
344+
return
345+
end if
346+
end if
347+
end subroutine get_default_argument
348+
349+
350+
pure subroutine get(self, idx, arg)
351+
class(argument_list), intent(in) :: self
352+
character(len=:), allocatable, intent(out) :: arg
353+
integer, intent(in) :: idx
354+
355+
if (idx > 0 .and. idx <= self%nargs) arg = self%argv(idx)%raw
356+
end subroutine get
357+
358+
pure function get_length(self) result(length)
359+
class(argument_list), intent(in) :: self
360+
integer :: length
361+
length = self%nargs
362+
end function get_length
363+
364+
end module dftd4_argument

0 commit comments

Comments
 (0)