Context Navigation

argparse.F90 @ 3590

Last change on this file since 3590 was 3090, checked in by slebonnois, 16 months ago
BdeBatz? : Cleans microphysics and makes few corrections for physics
File size: 117.8 KB

Line
1	! Copyright (c) (2013-2015,2017,2022) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
2	!
3	! This file is part of SWIFT
4	!
5	! Permission is hereby granted, free of charge, to any person obtaining a copy of
6	! this software and associated documentation files (the "Software"), to deal in
7	! the Software without restriction, including without limitation the rights to
8	! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
9	! the Software, and to permit persons to whom the Software is furnished to do so,
10	! subject to the following conditions:
11	!
12	! The above copyright notice and this permission notice shall be included in all
13	! copies or substantial portions of the Software.
14	!
15	! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16	! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
17	! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18	! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19	! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20	! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21
22	!! file: argparse.F90
23	!! summary: Command-line parser source file.
24	!! author: J. Burgalat
25	!! date: 2013-2015,2017,2022
26
27	#include "defined.h"
28
29	MODULE ARGPARSE
30	!> Command-line parsing module
31	!!
32	!! Here are described all the public members of argparse module.
33	!! For your own sanity, private methods that call Ancient Gods powers through
34	!! evil black magic rituals are not described here.
35	!!
36	!! If you only wish to have an overview of argparse usage, you'd better go
37	!! [here](\|url\|/page/swift/p01_argparse.html).
38
39	USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : stdout=>OUTPUT_UNIT, stderr=>ERROR_UNIT
40	USE ERRORS
41	USE FSYSTEM, ONLY : fs_termsize
42	USE STRING_OP, getpar => format_paragraph, splitstr => format_string
43	IMPLICIT NONE
44
45	PRIVATE
46
47	! Public members and imported features
48	! from errors: export everything (operator are exported latter)
49	PUBLIC :: noerror,error, error_to_string,aborting
50	! from strings
51	PUBLIC :: st_slen, st_llen
52	PUBLIC :: stderr, stdout
53	! argparse module
54	PUBLIC :: new_argparser, &
55	argparser_clear, &
56	argparser_add_option, &
57	argparser_add_positionals, &
58	argparser_throw_error, &
59	argparser_parse, &
60	argparser_help, &
61	argparser_get_positional, &
62	argparser_get_value, &
63	argparser_reset_values, &
64	argparser_found, &
65	argparser_get_num_values, &
66	argparser_found_positional, &
67	argparser_get_num_positional
68
69	PUBLIC :: OPERATOR(==), OPERATOR(/=), ASSIGNMENT(=)
70
71	! ===========================
72	! PARAMETERS (INTRISIC TYPES)
73	! ===========================
74
75	INTEGER, PARAMETER, PUBLIC :: ap_string = st_string
76	!! String value type identifier.
77	INTEGER, PARAMETER, PUBLIC :: ap_complex = st_complex
78	!! Complex value type identifier.
79	INTEGER, PARAMETER, PUBLIC :: ap_logical = st_logical
80	!! Logical value type identifier.
81	INTEGER, PARAMETER, PUBLIC :: ap_integer = st_integer
82	!! Integer value type identifier.
83	INTEGER, PARAMETER, PUBLIC :: ap_real = st_real
84	!! Real value type identifier.
85
86	!> List of all available actions
87
88	INTEGER, PARAMETER, PUBLIC :: ap_store = 1
89	!! store action ID : Each time the option is seen, values are replaced.
90	INTEGER, PARAMETER, PUBLIC :: ap_append = 2
91	!! append action ID : Each time the option is seen, values are appended.
92	INTEGER, PARAMETER, PUBLIC :: ap_count = 3
93	!! count action ID : increase a counter each time the option is seen.
94	INTEGER, PARAMETER, PUBLIC :: ap_help = 4
95	!! help action ID : help is requested !
96	INTEGER, PARAMETER, PUBLIC :: ap_version = 5
97	!! version action ID : version is requested !
98
99	!> List of all available actions
100	INTEGER, DIMENSION(5), PARAMETER, PRIVATE :: ap_actions = (/ap_store, &
101	ap_append, &
102	ap_count, &
103	ap_help, &
104	ap_version/)
105	!> List of all recognized types by the parser
106	INTEGER, DIMENSION(5), PARAMETER, PRIVATE :: ap_types = (/ap_string, &
107	ap_logical, &
108	ap_complex, &
109	ap_integer, &
110	ap_real/)
111	!> The unknown flag
112	!!
113	!! This flag is only intended to initialize flags. It is set by default during initialization
114	!! and quielty replaced by default flags, if user does not provide the relevant feature.
115	INTEGER, PARAMETER :: ap_undef = -1
116
117	!> Add an option to the parser
118	!!
119	!! ```
120	!! FUNCTION argparser_add_option(this,dest,sflag,lflag,type,action,default,nrec,help,meta) RESULT(err)
121	!! argparser_add_option(this,dest,flag,type,action,default,nrec,help,meta) RESULT(err)
122	!! ```
123	!!
124	!! The function defines a new argument based on input parameters, checks it and finally sets it
125	!! in the parser.
126	!!
127	!! In its first version both short (`sflag`) and long (`lflag`) options flags are mandatory. In its second
128	!! form, a single flag (`flag`) is expected: the method will automatically deduce if it belongs to short or
129	!! a long option flag based on the number of hyphens given.
130	!!
131	!! `type` value should be one of the following module constants (which are aliases from [[string_op(module)]]):
132	!!
133	!! - `ap_string` ([[string_op(module):st_string(variable)]])
134	!! - `ap_complex` ([[string_op(module):st_complex(variable)]])
135	!! - `ap_logical` ([[string_op(module):st_logical(variable)]])
136	!! - `ap_integer` ([[string_op(module):st_integer(variable)]])
137	!! - `ap_real` ([[string_op(module):st_real(variable)]])
138	!!
139	!! `action` value should be one of the following module constants:
140	!!
141	!! - [[argparse(module):ap_store(variable)]]
142	!! - [[argparse(module):ap_append(variable)]]
143	!! - [[argparse(module):ap_count(variable)]]
144	!! - [[argparse(module):ap_help(variable)]]
145	!!
146	!! `nrec` string can take the following forms:
147	!!
148	!! tag \| description
149	!! :---: \| : -------------
150	!! "?" \| zero or one argument's value
151	!! "*" \| any number of arguments
152	!! "+" \| one or more argument's value(s)
153	!! "X" \| Exactly X values. Where X is the string representation of an integer (0 is accepted).
154	!!
155	!! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
156	!! produced by misuse of the function arguments. In such case, the program should be
157	!! stopped: note that such error should not occur in _released_ programs.
158	INTERFACE argparser_add_option
159	MODULE PROCEDURE ap_add_option_1, ap_add_option_2
160	END INTERFACE
161
162	!> Get positional argument value(s)
163	INTERFACE argparser_get_positional
164	MODULE PROCEDURE ap_get_positional_sc, ap_get_positional_ve
165	END INTERFACE
166
167	!> Get optional argument value(s)
168	!!
169	!! ```
170	!! FUNCTION argparser_get_value(this,name,output) RESULT(err)
171	!! ```
172	!!
173	!! This is the generic method that can be used to retrieve any kind of argument value(s) from the parser for a given
174	!! argument name (as defined by the `dest` argument of [[argparse(module):argparser_add_option(interface)]].
175	!! All the methods have the same dummy arguments only `output` dummy argument differs in type and shape.
176	!!
177	!! @note
178	!! For string vector, `output` is expected to be an allocatable vector of assumed length
179	!! strings (thus string length is left to user responsability).
180	!! A good compromise for strings length is to use the [[string_op(module):st_slen(variable)]]
181	!! parameter.
182	INTERFACE argparser_get_value
183	MODULE PROCEDURE ap_get_dv_sc, ap_get_rv_sc, ap_get_iv_sc, ap_get_lv_sc, &
184	ap_get_cv_sc, ap_get_sv_sc, ap_get_dv_ve, ap_get_rv_ve, &
185	ap_get_iv_ve, ap_get_lv_ve, ap_get_cv_ve, ap_get_sv_ve
186	END INTERFACE
187
188	!> Interface to [[argparse(module):argc(type)]] getters
189	!!
190	!! All the functions have the same prototype, only kind and type of arguments changed
191	!! from a function to the other.
192	INTERFACE argc_get_value
193	MODULE PROCEDURE ac_get_dv_sc, ac_get_rv_sc, ac_get_iv_sc, ac_get_lv_sc, &
194	ac_get_cv_sc, ac_get_sv_sc, ac_get_dv_ve, ac_get_rv_ve, &
195	ac_get_iv_ve, ac_get_lv_ve, ac_get_cv_ve, ac_get_sv_ve
196	END INTERFACE
197
198	!> argc equality operator
199	INTERFACE OPERATOR(==)
200	MODULE PROCEDURE ac_equals_arg
201	END INTERFACE
202
203	!> argc inequality operator
204	INTERFACE OPERATOR(/=)
205	MODULE PROCEDURE ac_differs_arg
206	END INTERFACE
207
208	!> argc assignment statement
209	INTERFACE ASSIGNMENT(=)
210	MODULE PROCEDURE ac_affect_arg
211	MODULE PROCEDURE ap_affect_parser
212	END INTERFACE
213
214	!> argc destructors interface
215	INTERFACE clear_argc
216	MODULE PROCEDURE ac_clear_arg_sc, ac_clear_arg_ve
217	END INTERFACE
218
219
220	TYPE, PRIVATE :: argc
221	!! Defines a command-line argument.
222	!!
223	!! An [[argparse(module):argc(type)]] object stores all information about a command-line
224	!! argument, that is:
225	!!
226	!! - its name
227	!! - its optional flags
228	!! - its type
229	!! - its action
230	!! - and finally its values
231	PRIVATE
232	INTEGER :: ptype = ap_logical
233	!! Type flag (an integer from enum argparse::ap_types)
234	INTEGER :: paction = ap_store
235	!! Action flag (an integer from enum argparse::ap_actions)
236	INTEGER :: nrec = 0
237	!! Number of values
238	LOGICAL :: fnd = .false.
239	!! A boolean flag set to `.true.` if argument has been found in the command-line.
240	TYPE(words) :: values
241	!! Values of the argument
242	CHARACTER(len=2) :: sflag = " "
243	!! Short flag option
244	TYPE(words) :: meta
245	!! Meta variable name(s) of the argument
246	#if HAVE_FTNDTSTR
247	CHARACTER(len=:), ALLOCATABLE :: default
248	!! Default flag
249	CHARACTER(len=:), ALLOCATABLE :: name
250	!! Name of the argument (needed to check and retrieve its value(s))
251	CHARACTER(len=:), ALLOCATABLE :: lflag
252	!! Long flag option (st_short_len max chars !)
253	CHARACTER(len=:), ALLOCATABLE :: help
254	!! Help about the argument
255	#else
256	CHARACTER(len=st_slen) :: default = ""
257	!! Default flag
258	CHARACTER(len=st_slen) :: name
259	!! Name of the argument (needed to check and retrieve its value(s))
260	CHARACTER(len=st_slen) :: lflag = ""
261	!! Long flag option (st_short_len max chars !)
262	CHARACTER(len = 200) :: help = ""
263	!! Help about the argument
264	#endif
265	END TYPE argc
266
267
268	TYPE, PUBLIC :: argparser
269	!! Command-line parser
270	!!
271	!! This is the main object of the module. It stores definitions of CLI arguments and
272	!! their value(s) once the command-line have been parsed.
273	TYPE(argc), PRIVATE, ALLOCATABLE, DIMENSION(:) :: args
274	!! List of defined arguments
275	INTEGER, PRIVATE :: nargs = 0
276	!! Size of args
277	INTEGER, PRIVATE :: parsed = -1
278	!! Parsing control flag
279	!!
280	!! The parsing flag determines if the command line have been parsed :
281	!!
282	!! - -1 : not parsed yet
283	!! - 0 : unsuccessfully parsed
284	!! - 1 : successfully parsed
285	TYPE(argc), PRIVATE :: posals
286	!! Positionals arguments (defined as a single argc object)
287	LOGICAL, PRIVATE :: have_posal = .false.
288	!! Positional control flag
289	#if HAVE_FTNDTSTR
290	CHARACTER(len=:), PRIVATE, ALLOCATABLE :: usg
291	!! Program command usage
292	CHARACTER(len=:), PRIVATE, ALLOCATABLE :: descr
293	!! Program help description
294	CHARACTER(len=:), PRIVATE, ALLOCATABLE :: eplg
295	!! Program help epilog
296	CHARACTER(len=:), PRIVATE, ALLOCATABLE :: vers
297	!! Application version string
298	#else
299	CHARACTER(len=st_llen), PRIVATE :: usg
300	!! Program command usage
301	CHARACTER(len=st_llen), PRIVATE :: descr
302	!! Program help description
303	CHARACTER(len=st_llen), PRIVATE :: eplg
304	!! Program help epilog
305	CHARACTER(len=st_llen), PRIVATE :: vers
306	!! Application version string
307	#endif
308	INTEGER, PRIVATE :: mxhlpos = 20
309	!! Position of the short help for options
310	INTEGER, PRIVATE :: width = 0
311	!! Maximum width of the help
312	LOGICAL, PRIVATE :: init = .false.
313	!! Initialization control flag
314	#if HAVE_FTNPROC
315
316	CONTAINS
317	PROCEDURE, PRIVATE :: ap_add_option_1
318	PROCEDURE, PRIVATE :: ap_add_option_2
319	PROCEDURE, PRIVATE :: ap_get_positional_sc
320	PROCEDURE, PRIVATE :: ap_get_positional_ve
321	PROCEDURE, PRIVATE :: ap_get_dv_sc
322	PROCEDURE, PRIVATE :: ap_get_rv_sc
323	PROCEDURE, PRIVATE :: ap_get_iv_sc
324	PROCEDURE, PRIVATE :: ap_get_lv_sc
325	PROCEDURE, PRIVATE :: ap_get_cv_sc
326	PROCEDURE, PRIVATE :: ap_get_sv_sc
327	PROCEDURE, PRIVATE :: ap_get_dv_ve
328	PROCEDURE, PRIVATE :: ap_get_rv_ve
329	PROCEDURE, PRIVATE :: ap_get_iv_ve
330	PROCEDURE, PRIVATE :: ap_get_lv_ve
331	PROCEDURE, PRIVATE :: ap_get_cv_ve
332	PROCEDURE, PRIVATE :: ap_get_sv_ve
333	PROCEDURE, PRIVATE :: ap_check_state
334	PROCEDURE, PUBLIC :: throw_error => argparser_throw_error
335	!! Throw an error and exit the program
336	PROCEDURE, PUBLIC :: parse => argparser_parse
337	!! Parse the command-line (or the given input string).
338	PROCEDURE, PUBLIC :: help => argparser_help
339	!! Compute and print help
340	PROCEDURE, PUBLIC :: version => argparser_version
341	!! print version string
342	PROCEDURE, PUBLIC :: found => argparser_found
343	!! Check if an optional argument has been found on the command-line
344	PROCEDURE, PUBLIC :: get_num_values => argparser_get_num_values
345	!! Get the actual number of values stored in an argument.
346	PROCEDURE, PUBLIC :: found_positional => argparser_found_positional
347	!! Check if positional argument(s) has been found on the command-line
348	PROCEDURE, PUBLIC :: get_num_positional => argparser_get_num_positional
349	!! Get the actual number of values stored as positionals.
350	PROCEDURE, PUBLIC :: add_positionals => argparser_add_positionals
351	!! Add positionals definitions in the parser.
352	!> Add optional argument definition in the parser.
353	GENERIC, PUBLIC :: add_option => ap_add_option_1, &
354	ap_add_option_2
355	!> Get the values of the positionals stored in the parser.
356	GENERIC, PUBLIC :: get_positional => ap_get_positional_sc, &
357	ap_get_positional_ve
358	!> Get the value(s) of the given argument stored in the parser.
359	GENERIC, PUBLIC :: get_value => ap_get_dv_sc, &
360	ap_get_rv_sc, &
361	ap_get_iv_sc, &
362	ap_get_lv_sc, &
363	ap_get_cv_sc, &
364	ap_get_sv_sc, &
365	ap_get_dv_ve, &
366	ap_get_rv_ve, &
367	ap_get_iv_ve, &
368	ap_get_lv_ve, &
369	ap_get_cv_ve, &
370	ap_get_sv_ve
371	#endif
372	END TYPE argparser
373
374	CONTAINS
375
376	! argparser main methods (public)
377	! -------------------------------
378
379	FUNCTION new_argparser(usg, dsc, epg, add_help, add_version, version_string,width, max_help_pos) RESULT(this)
380	!! Initialize an argparser object.
381	!!
382	!! The method initializes (properly) an [[argparse(module):argparser(type)]] object.
383	!! Even if all the arguments are optional, it is mandatory to call the method
384	!! before using an argparser object.
385	CHARACTER(len=*), INTENT(in), OPTIONAL :: usg
386	!! An optional string with the command line usage of the program. If it is not given
387	!! command-line usage is automatically built from informations set in the parser.
388	CHARACTER(len=*), INTENT(in), OPTIONAL :: dsc
389	!! An optional string with the short description of the program.
390	CHARACTER(len=*), INTENT(in), OPTIONAL :: epg
391	!! An optional string with the epilog of the program's help
392	LOGICAL, INTENT(in), OPTIONAL :: add_help
393	!! An optional boolean flag with `.true.` to automatically set an option for program's help.
394	!! Note that, the option flags `-h` and `--help` are no more available in that case.
395	LOGICAL, INTENT(in), OPTIONAL :: add_version
396	!! An optional boolean flag with `.true.` to automatically set an option for program's help.
397	!! Note that, the option flags `-V` and `--version` are no more available in that case.
398	CHARACTER(len=*), INTENT(in), OPTIONAL :: version_string
399	!! An optional string with the text to display if the version option is found on the
400	!! command line. The text is displayed without any format.
401	INTEGER, INTENT(in), OPTIONAL :: width
402	!! An optional integer with the maximum width the help text.
403	INTEGER, INTENT(in), OPTIONAL :: max_help_pos
404	!! An optional integer with the maximum position of the help string for each option of
405	!! the program when help is requested. Note that this value is just an indicator. The
406	!! helper computes the minimum position between this value and the maximum length of the
407	!! options flags.
408	TYPE(argparser) :: this
409	!! An initialized argparse object.
410	INTEGER :: zh
411	TYPE(error) :: err
412	! We always clear the parser
413	CALL argparser_clear(this)
414	! Set keywords
415	IF (PRESENT(usg)) THEN ; this%usg=usg ; ELSE ; this%usg='' ; ENDIF
416	IF (PRESENT(dsc)) THEN ; this%descr=dsc ; ELSE ; this%descr='' ; ENDIF
417	IF (PRESENT(epg)) THEN ; this%eplg=epg ; ELSE ; this%eplg='' ; ENDIF
418	CALL fs_termsize(zh,this%width)
419	IF (PRESENT(width)) this%width = MAX(width,50)
420	IF(PRESENT(max_help_pos)) this%mxhlpos = MAX(5,max_help_pos)
421	this%init = .true. ! before adding option !!!
422	IF (PRESENT(add_help)) THEN
423	IF (add_help) &
424	err = argparser_add_option(this,'help',sflag='-h',lflag='--help', &
425	action=ap_help, help="Print this help and quit")
426	ENDIF
427	IF (PRESENT(add_version)) THEN
428	IF (add_version) &
429	err = argparser_add_option(this,'version',sflag='-V',lflag='--version', &
430	action=ap_version, help="Print the application version and quit")
431	this%vers = ''
432	if (PRESENT(version_string)) this%vers = TRIM(version_string)
433	ENDIF
434	RETURN
435	END FUNCTION new_argparser
436
437	SUBROUTINE argparser_clear(this)
438	!! Clear the parser
439	!! The subroutine is used as finalization subroutine of argparser type.
440	!! Once the method is called, the object is no more usable until it is
441	!! (re)initialized by calling argparse::new_argparser.
442	!! @note If fccp has not been built with support for finalization subroutine,
443	!! it should be called whenever the argparser object is no more used.
444	TYPE(argparser), INTENT(inout) :: this
445	!! An argparser object
446	IF (ALLOCATED(this%args)) THEN
447	CALL clear_argc(this%args)
448	DEALLOCATE(this%args)
449	ENDIF
450	! maybe we should should set this%posals as allocatable
451	CALL clear_argc(this%posals)
452	this%nargs = 0
453	this%parsed = -1
454	this%have_posal = .false.
455	this%usg = ''
456	this%descr = ''
457	this%eplg = ''
458	this%mxhlpos = 20
459	this%width = 0
460	this%init = .false.
461	END SUBROUTINE argparser_clear
462
463	SUBROUTINE argparser_reset_values(this)
464	!! Reset all arguments values in the parser
465	!! The method only deletes arguments value(s) currently stored in the parser.
466	OBJECT(argparser), INTENT(inout) :: this
467	!! An argparser object reference
468	! Check if list is empty
469	IF (this%nargs == 0) RETURN
470	CALL words_clear(this%args(:)%values)
471	CALL words_clear(this%posals%values)
472	END SUBROUTINE argparser_reset_values
473
474	FUNCTION argparser_add_positionals(this,nargs,meta,help) RESULT(err)
475	!! Add positional arguments definition to the parser.
476	!!
477	!! The method initializes the entry for positional arguments in the parser.
478	!! Positional arguments are always seen by the parser as strings and the
479	!! default associated action is 'store'.
480	OBJECT(argparser), INTENT(inout) :: this
481	!! An argparser object reference
482	CHARACTER(len=*), INTENT(in) :: nargs
483	!! A string with the expected number of specified values for the option
484	CHARACTER(len=*), INTENT(in), DIMENSION(:), OPTIONAL :: meta
485	!! A vector of strings with the the displayed value name(s) of the positionals in the help command
486	CHARACTER(len=*), INTENT(in), OPTIONAL :: help
487	!! An optional string with a short description of the positional argument(s)
488	TYPE(error) :: err
489	!! Error object with the first error encountered in the process.
490	INTEGER :: ty,ac
491	CHARACTER(len=:), ALLOCATABLE :: sf,lf,de
492	err = noerror
493	IF (.NOT.this%init) THEN
494	err = error("argparse: parser not initialized yet",-1)
495	RETURN
496	ENDIF
497	IF (this%have_posal) THEN
498	err = error('argparse: positionals arguments already defined',-8)
499	RETURN
500	ELSE
501	this%posals%name = 'positional'
502	sf = ' ' ; lf = '' ; ty = ap_string ; ac = ap_store ; de = ''
503	IF (PRESENT(help)) THEN
504	this%posals%help = TRIM(help)
505	ELSE
506	this%posals%help = ''
507	ENDIF
508	IF (PRESENT(meta)) THEN
509	err = ac_check_and_set(this%posals,sf,lf,ty,ac,de,nargs,meta,.false.)
510	ELSE
511	err = ac_check_and_set(this%posals,sf,lf,ty,ac,de,nargs,check_flag=.false.)
512	ENDIF
513	IF (err /= noerror) THEN
514	RETURN
515	ENDIF
516	this%have_posal = this%posals%nrec /= 0
517	ENDIF
518	RETURN
519	END FUNCTION argparser_add_positionals
520
521	FUNCTION argparser_parse(this,cmd_line,auto) RESULT(err)
522	!! Parse the command line
523	!! The method parses either the command-line or the string `cmd_line`
524	!! given as optional argument and fills the parser's arguments.
525	!! @note
526	!! If `cmd_line` is provided it should not contains the name of the program or
527	!! the parsing process will certainly failed: program name will be seen as the
528	!! first positional argument and all tokens of the string will then be seen as
529	!! positional.
530	OBJECT(argparser), INTENT(inout) :: this
531	!! An argparser object reference
532	CHARACTER(len=*), INTENT(in), OPTIONAL :: cmd_line
533	!! An optional string to parse that substitute for the actual command-line.
534	LOGICAL, INTENT(in), OPTIONAL :: auto
535	!! An optional boolean flag with `.true.` to instruct the parser wether to perform
536	!! automatic actions or not when error occur during parsing. If `auto` is enabled,
537	!! then the parser dumps program's usage and stops the program on error.
538	TYPE(error) :: err
539	!! Error object with the first error encountered in the process.
540	CHARACTER(len=:), ALLOCATABLE :: cline,z
541	LOGICAL :: zauto
542	LOGICAL :: rhelp
543	LOGICAL :: rvers
544	INTEGER :: l
545	TYPE(words) :: cmd_tokens
546	err = noerror
547	IF (.NOT.this%init) THEN
548	err = error("parser not initialized yet",-1) ; RETURN
549	ENDIF
550	rhelp = .false. ; rvers = .false.
551	zauto = .false. ; IF (PRESENT(auto)) zauto = auto
552	IF (PRESENT(cmd_line)) THEN
553	ALLOCATE(cline,source=cmd_line)
554	ELSE
555	CALL GET_COMMAND(length=l)
556	ALLOCATE(CHARACTER(len=l) :: z) ; CALL GET_COMMAND(z)
557	CALL GET_COMMAND_ARGUMENT(0,length=l)
558	IF (l >= LEN_TRIM(z)) THEN ; cline='' ; ELSE ; cline=z(l+1:LEN(z)) ; ENDIF
559	DEALLOCATE(z)
560	ENDIF
561	! reset parsing status
562	this%parsed = -1
563	CALL argparser_reset_values(this)
564	DO
565	! Do we have to launch the turbine ?
566	IF (LEN_TRIM(cline) == 0) THEN
567	IF (this%have_posal) err=error("Wrong number of arguments",-16)
568	EXIT ! ... No :)
569	ELSE
570	err = ap_split_cmd(this,cline,cmd_tokens,rhelp)
571	! we only stops processing if :
572	! - the internal error (string length) is raised
573	! - help flag found AND auto has been set
574	IF (err /= noerror .OR. (rhelp.AND.zauto)) EXIT
575	ENDIF
576	CALL words_reset(cmd_tokens) ! not mandatory... at least theoretically
577	! Parses the options
578	err = ap_parse_options(this,cmd_tokens,rhelp,rvers)
579	IF (err /= noerror) EXIT
580	! exit loop if help or version is requested. Parser is not completely filled but we
581	! expect someone to use the help or version actions...
582	IF (rhelp.OR.rvers) EXIT
583	! Parses positionals
584	err = ap_parse_positionals(this,cmd_tokens)
585	EXIT ! A one iterated loop :)
586	ENDDO
587	IF (err /= 0) THEN
588	CALL argparser_reset_values(this)
589	ELSE
590	this%parsed = 1
591	ENDIF
592	IF (zauto) THEN
593	IF (rhelp) CALL argparser_help(this)
594	IF (rvers) CALL argparser_version(this)
595	IF (err /= 0) CALL argparser_throw_error(this,err,2)
596	ENDIF
597	RETURN
598	END FUNCTION argparser_parse
599
600	SUBROUTINE argparser_version(this)
601	!! Print version string and exit program
602	OBJECT(argparser), INTENT(inout) :: this
603	!! An argparser object reference
604	WRITE(stdout,'(a)') TRIM(this%vers)
605	CALL argparser_clear(this)
606	CALL EXIT(0)
607	END SUBROUTINE argparser_version
608
609	SUBROUTINE argparser_help(this)
610	!! Print help and exit program
611	OBJECT(argparser), INTENT(inout) :: this
612	!! An argparser object reference
613	CHARACTER(len=:), ALLOCATABLE :: helpme
614	!!!! WARNING we set no indication here !!!
615	IF (.NOT.this%init) RETURN
616	helpme = ap_gen_help(this)
617
618	WRITE(stdout,'(a)') helpme
619
620	CALL argparser_clear(this)
621	! Finally we exit the program
622	CALL EXIT(0)
623	END SUBROUTINE argparser_help
624
625	SUBROUTINE argparser_throw_error(this,err,exit_id)
626	!! Dump error on standard error and exit
627	!!
628	!! The method performs the following actions:
629	!!
630	!! - Print the usage command of the program
631	!! - Dump the provided @p error message
632	!! - Call parser's clean-up subroutine (if a cleaner callback has been given during the
633	!! parser's initialization, see [[argparse(module):new_argparser(function)]] documentation
634	!! - Stop the program
635	!!
636	!! The error message is always printed in standard error output.
637	!! @note
638	!! If errors::error::id is 0 the method does nothing.
639	OBJECT(argparser), INTENT(inout) :: this
640	!! An argparser object reference
641	TYPE(error), INTENT(in) :: err
642	!! An error object with the error to print
643	INTEGER, INTENT(in), OPTIONAL :: exit_id
644	!! An optional integer with the exit code (default to 2)
645	CHARACTER(len=:), ALLOCATABLE :: pgn
646	TYPE(error) :: zerr
647	IF (err == 0) RETURN
648	zerr = error(err%msg,2)
649	IF (PRESENT(exit_id)) zerr%id=exit_id
650	CALL ap_format_usage(this)
651	WRITE(stderr,'(a)') TRIM(this%usg)//NEW_LINE('A')
652	! clean the parser
653	CALL argparser_clear(this)
654	pgn = get_progname()
655	WRITE(stderr,'(a)') pgn//": error: "//TRIM(err%msg)
656	CALL EXIT(err%id)
657	END SUBROUTINE argparser_throw_error
658
659	FUNCTION argparser_found(this,argname) RESULT(found)
660	!! Check wether an argument has been found in the command-line.
661	!! @note
662	!! Keep in mind that arguments in the parser always have a default
663	!! value. This method is not intended to check if an argument has a value but
664	!! only if it has been seen on the command-line !
665	OBJECT(argparser), INTENT(in) :: this
666	!! An argparser object reference
667	CHARACTER(len=*), INTENT(in) :: argname
668	!! Name of the argument to check
669	LOGICAL :: found
670	!! `.true.` if the option has been parsed, `.false.` otherwise
671	INTEGER :: idx
672	idx = ap_get_arg_index(this,argname)
673	IF (idx == -1) THEN
674	found = .false.
675	ELSE
676	found = ac_found(this%args(idx))
677	ENDIF
678	END FUNCTION argparser_found
679
680	FUNCTION argparser_get_num_values(this,argname) RESULT(num)
681	!! Get the actual number of values stored in an argument.
682	OBJECT(argparser), INTENT(in) :: this
683	!! An argparser object reference
684	CHARACTER(len=*), INTENT(in) :: argname
685	!! Name of the argument to check.
686	INTEGER :: num
687	!! The number of actual values stored in the argument
688	INTEGER :: idx
689	idx = ap_get_arg_index(this,argname)
690	IF (idx == -1) THEN
691	num = 0
692	ELSE
693	num = words_length(this%args(idx)%values)
694	ENDIF
695	END FUNCTION argparser_get_num_values
696
697	FUNCTION argparser_found_positional(this) RESULT(ret)
698	!! Check if positional(s) has been found in the command line.
699	OBJECT(argparser), INTENT(in) :: this
700	!! An argparser object reference
701	LOGICAL :: ret
702	!! `.true.` if found, `.false.` otherwise
703	TYPE(error) :: err
704	ret = .false.
705	IF (this%have_posal) THEN
706	ret = this%posals%fnd
707	ENDIF
708	END FUNCTION argparser_found_positional
709
710	FUNCTION argparser_get_num_positional(this) RESULT(ret)
711	!! Get the actual number of positional argument values stored in the parser .
712	OBJECT(argparser), INTENT(in) :: this
713	!! An argparser object reference
714	INTEGER :: ret
715	!! The number of actual positionals arguments
716	ret = 0
717	IF (this%have_posal) THEN
718	ret = words_length(this%posals%values)
719	ENDIF
720	END FUNCTION argparser_get_num_positional
721
722	! argparser private methods
723	! -------------------------
724
725	FUNCTION ap_check_state(this) RESULT(err)
726	!! Check current parser state
727	!! The method returns an error based on the current parser's state:
728	!! - Parser is ready (0)
729	!! - parsing not done yet (-19)
730	!! - parsing (already) failed (-20)
731	!! - parser is NOT initialized (-1)
732	OBJECT(argparser), INTENT(in) :: this
733	!! An argparser object reference
734	TYPE(error) :: err
735	!! Error object with the status of the parser
736	err = noerror
737	IF (this%parsed == -1) THEN
738	err = error("argparse: Command-line not parsed (yet)",-19)
739	ELSE IF (this%parsed == 0) THEN
740	err = error("argparse: command-line parsing failed",-20)
741	ELSE IF (.NOT.this%init) THEN
742	err = error("argparse: parser not initialized yet",-1)
743	ENDIF
744	RETURN
745	END FUNCTION ap_check_state
746
747	SUBROUTINE ap_append_arg(this,arg)
748	!! Append an argument to the list of arguments.
749	TYPE(argparser), INTENT(inout) :: this
750	!! An argparser object reference
751	TYPE(argc), INTENT(in) :: arg
752	!! An [[argparse(module):argc(type)]] object with the argument to add
753	INTEGER :: i
754	TYPE(argc), ALLOCATABLE, DIMENSION(:) :: tmp
755	TYPE(error) :: err
756	IF (.NOT.this%init) THEN
757	err = error("parser not initialized yet",-1) ; RETURN
758	ENDIF
759	! Empty list : we create it
760	IF (this%nargs == 0) THEN
761	ALLOCATE(this%args(1))
762	this%args(1) = arg
763	this%nargs = 1
764	RETURN
765	ENDIF
766	! Adds a new argument to the vector of arguments
767	! we will make a test with move_alloc but i'm not sure it does everything
768	! the way we want (keep in mind that there is some pointer in argc members
769	! !!!)
770	ALLOCATE(tmp(this%nargs))
771	DO i=1,this%nargs ; tmp(i) = this%args(i) ; ENDDO
772	CALL clear_argc(this%args)
773	DEALLOCATE(this%args)
774	this%nargs = this%nargs+1 ; ALLOCATE(this%args(this%nargs))
775	DO i=1,this%nargs-1 ; this%args(i) = tmp(i) ; ENDDO
776	CALL clear_argc(tmp)
777	DEALLOCATE(tmp)
778	this%args(i) = arg
779	RETURN
780	END SUBROUTINE ap_append_arg
781
782	FUNCTION ap_get_arg_index(this, name, sflag, lflag) RESULT(idx)
783	!! Get an argument by name or option flag in the parser.
784	TYPE(argparser), INTENT(in), TARGET :: this
785	!! An argparser object reference
786	CHARACTER(len=*), INTENT(in), OPTIONAL :: name
787	!! An optional string with the name of the argument
788	CHARACTER(len=*), INTENT(in), OPTIONAL :: lflag
789	!! An optional string with the long option flag of the argument
790	CHARACTER(len=2), INTENT(in), OPTIONAL :: sflag
791	!! An optional string with the short option flag of the argument
792	INTEGER :: idx
793	!! Index of the argument in the internal vector of argument or -1 if no argument is found.
794	INTEGER :: i,nn,nl,ns
795	CHARACTER(LEN=:), ALLOCATABLE :: lna, llf
796	CHARACTER(LEN=2) :: lsf
797	idx = -1
798	IF (.NOT.this%init) RETURN
799	lna="" ; IF(PRESENT(name)) lna = name ; nn = LEN_TRIM(lna)
800	lsf="" ; IF(PRESENT(sflag)) lsf = sflag ; ns = LEN_TRIM(lsf)
801	llf="" ; IF(PRESENT(lflag)) llf = lflag ; nl = LEN_TRIM(llf)
802	IF (nn == 0 .AND. ns == 0 .AND. nl == 0) RETURN
803	! empty parser
804	IF (this%nargs == 0) RETURN
805	DO i=1, this%nargs
806	IF ((nn /= 0 .AND. TRIM(this%args(i)%name) == TRIM(lna)) .OR. &
807	(ns /= 0 .AND. TRIM(this%args(i)%sflag) == TRIM(lsf)) .OR. &
808	(nl /= 0 .AND. TRIM(this%args(i)%lflag) == TRIM(llf))) THEN
809	idx = i ; RETURN
810	ENDIF
811	ENDDO
812	RETURN
813	END FUNCTION ap_get_arg_index
814
815
816	FUNCTION ap_add_option_1(this,dest,sflag,lflag,type,action,default,nrec,help,meta) RESULT(err)
817	!! Add an argument to the parser (interface #1)
818	!!
819	!! The function defines a new argument based on input parameters, checks it and finally sets it
820	!! in the parser. Both short and long options flags are mandatory input arguments of the function.
821	!!
822	!! `type` value should be one of the following module constants (which are aliases from [[string_op(module)]]):
823	!! - ap_string ([[string_op(module):st_string(variable)]])
824	!! - ap_complex ([[string_op(module):st_complex(variable)]])
825	!! - ap_logical ([[string_op(module):st_logical(variable)]])
826	!! - ap_integer ([[string_op(module):st_integer(variable)]])
827	!! - ap_real ([[string_op(module):st_real(variable)]])
828	!!
829	!! `action` value should be one of the following module constants:
830	!! - [[argparse(module):ap_store(variable)]]
831	!! - [[argparse(module):ap_append(variable)]]
832	!! - [[argparse(module):ap_count(variable)]]
833	!! - [[argparse(module):ap_help(variable)]]
834	!!
835	!! `nrec` string can take the following forms:
836	!! tag \| description
837	!! :-: \| : -------------
838	!! ? \| zero or one argument's value
839	!! * \| any number of arguments
840	!! + \| one or more argument's value(s)
841	!! X \| Exactly X values. Where X is the string representation of an integer (0 is accepted).
842	!!
843	!! See also ap_add_option_2 documentation.
844	OBJECT(argparser), INTENT(inout) :: this
845	!! An argparser object reference
846	CHARACTER(len=*), INTENT(in) :: dest
847	!! A string with the name of the argument
848	CHARACTER(len=2), INTENT(in) :: sflag
849	!! A two characters string with the short option flag of the argument
850	CHARACTER(len=*), INTENT(in) :: lflag
851	!! A string (3 characters minimum) with the long option flag of the argument
852	INTEGER, INTENT(in), OPTIONAL :: type
853	!! An integer with the type of the argument
854	INTEGER, INTENT(in), OPTIONAL :: action
855	!! An integer with the action of the argument
856	CHARACTER(len=*), INTENT(in), OPTIONAL :: default
857	!! A string with the default value of the argument if not provided in the CLI
858	CHARACTER(len=*), INTENT(in), OPTIONAL :: nrec
859	!! A string with the expected number of specified values for the argument in the CLI.
860	CHARACTER(len=*), INTENT(in), OPTIONAL :: help
861	!! A string with a short description of the argument
862	CHARACTER(len=*), DIMENSION(:), INTENT(in), OPTIONAL :: meta
863	!! A vector of strings with the displayed value's name(s) of the argument in the help command
864	TYPE(error) :: err
865	!! Error object with the first error encountered in the process.
866	CHARACTER(len=:), ALLOCATABLE :: de,na,he
867	INTEGER :: ty,ac
868	TYPE(argc) :: arg
869	err = noerror
870	he = "" ; IF (PRESENT(help)) he = TRIM(help)
871	na = "" ; IF (PRESENT(nrec)) na = TRIM(nrec)
872	ty = ap_undef ; IF (PRESENT(type)) ty = type
873	ac = ap_undef ; IF (PRESENT(action)) ac = action
874	de ='' ; IF (PRESENT(default)) de = TRIM(default)
875	IF (.NOT.this%init) THEN
876	err = error("argparse: parser not initialized yet",-1)
877	RETURN
878	ENDIF
879	IF (LEN_TRIM(dest) == 0) THEN
880	err = error("argparse: Invalid argument (empty dest)",-2)
881	RETURN
882	ENDIF
883	arg%name = TRIM(dest) ; arg%help = TRIM(he)
884	IF (PRESENT(meta)) THEN
885	err = ac_check_and_set(arg,sflag,lflag,ty,ac,de,na,meta)
886	ELSE
887	err = ac_check_and_set(arg,sflag,lflag,ty,ac,de,na)
888	ENDIF
889	IF (err /= noerror) RETURN
890	err = ap_check_in_parser(this,arg)
891	IF (err /= noerror) RETURN
892	CALL ap_append_arg(this,arg)
893	CALL clear_argc(arg)
894	END FUNCTION ap_add_option_1
895
896	FUNCTION ap_add_option_2(this,dest,flag,type,action,default,nrec,help,meta) RESULT(err)
897	!! Add an argument to the parser (interface #2)
898	!!
899	!! The function is a wrapper to ap_add_option_1. In this version,
900	!! only one option flag is required. The method only checks for the (trimmed) length of flag in
901	!! order to choose wether it is a short or long option flag. Then the function simply calls
902	!! ap_add_option_1 to set the argument.
903	!!
904	!! Other dummy arguments have the same meaning as in ap_add_option_1.
905	OBJECT(argparser), INTENT(inout) :: this
906	!! An argparser object reference
907	CHARACTER(len=*), INTENT(in) :: dest
908	!! A string with the name of the argument
909	CHARACTER(len=*), INTENT(in) :: flag
910	!! A string with either the short or long option flag
911	INTEGER, INTENT(in), OPTIONAL :: type
912	!! A string with the type of the argument
913	INTEGER, INTENT(in), OPTIONAL :: action
914	!! A string with the action of the argument
915	CHARACTER(len=*), INTENT(in), OPTIONAL :: default
916	!! A string with the default value of the argument if not provided in the CLI
917	CHARACTER(len=*), INTENT(in), OPTIONAL :: nrec
918	!! A string with the expected number of specified values for the argument in the CLI.
919	CHARACTER(len=*), INTENT(in), OPTIONAL :: help
920	!! A string with a short description of the argument
921	CHARACTER(len=*), DIMENSION(:), INTENT(in), OPTIONAL :: meta
922	!! A vector of strings with the displayed value's name(s) of the argument in the help command
923	TYPE(error) :: err
924	!! Error object with the first error encountered in the process.
925	CHARACTER(len=:), ALLOCATABLE :: sf,lf,de,na,he
926	INTEGER :: ty,ac
927	err = noerror
928	sf = ' ' ; lf = ''
929	IF (LEN_TRIM(flag) == 2) THEN
930	sf = TRIM(flag)
931	ELSE
932	lf = TRIM(flag)
933	ENDIF
934	he = "" ; IF (PRESENT(help)) he = TRIM(help)
935	na = "" ; IF (PRESENT(nrec)) na = TRIM(nrec)
936	ty = ap_undef ; IF (PRESENT(type)) ty = type
937	ac = ap_undef ; IF (PRESENT(action)) ac = action
938	de = '' ; IF (PRESENT(default)) de = TRIM(default)
939	! Calling "true" function
940	IF (PRESENT(meta)) THEN
941	err = ap_add_option_1(this,dest,sf,lf,ty,ac,de,na,he,meta)
942	ELSE
943	err = ap_add_option_1(this,dest,sf,lf,ty,ac,de,na,he)
944	ENDIF
945	RETURN
946	END FUNCTION ap_add_option_2
947
948	FUNCTION ap_check_in_parser(this,arg) RESULT(err)
949	!! Check if an argument is already set in the parser
950	!! An argument is assumed to be already set in the parser if either its name,
951	!! short or long option flag is already defined (in the parser).
952	OBJECT(argparser), INTENT(in) :: this
953	!! An argparser object reference
954	TYPE(argc), INTENT(in) :: arg
955	!! An argc object to check
956	TYPE(error) :: err
957	!! Error object with -8 id if object is already set, no error otherwise.
958	INTEGER :: i
959	err = noerror
960	IF (this%nargs == 0 ) RETURN
961	DO i=1,this%nargs
962	! note : we could have use the == operator but we want to get an specific
963	! error message)
964	IF (TRIM(this%args(i)%name) == TRIM(arg%name)) THEN
965	err = error("argparse: argument '"//TRIM(arg%name)//"' already defined",-8) ; RETURN
966	ENDIF
967	IF (LEN_TRIM(this%args(i)%sflag) > 0 .AND. &
968	TRIM(this%args(i)%sflag) == TRIM(arg%sflag)) THEN
969	err = error("argparse: flag '"//TRIM(arg%sflag)//"' already defined",-8) ; RETURN
970	ENDIF
971	IF (LEN_TRIM(this%args(i)%lflag) > 0 .AND. &
972	TRIM(this%args(i)%lflag) == TRIM(arg%lflag)) THEN
973	err = error("argparse: flag '"//TRIM(arg%lflag)//"' already defined",-8) ; RETURN
974	ENDIF
975	ENDDO
976	RETURN
977	END FUNCTION ap_check_in_parser
978
979	FUNCTION ap_parse_options(this,cmd,help_req,vers_req) RESULT(err)
980	!! Parse options of the internal command line
981	!! This (internal) function manages the parsing of the command line options.
982	OBJECT(argparser), INTENT(inout), TARGET :: this
983	!! An argparser object reference
984	TYPE(words), INTENT(inout) :: cmd
985	!! A [[string_op(module):words(type)]] object with the command-line to parse
986	LOGICAL, INTENT(out) :: help_req
987	!! An output logical flag with `.true.` if help option has been found, `.false.` otherwise
988	LOGICAL, INTENT(out) :: vers_req
989	!! An output logical flag with `.true.` if version option has been found, `.false.` otherwise
990	TYPE(error) :: err
991	!! Error object with the first error encountered in the process
992	CHARACTER(len=1), PARAMETER :: sq = CHAR(39)
993	CHARACTER(len=:), ALLOCATABLE :: elt
994	INTEGER :: arg_idx
995	INTEGER :: i,nv,ic
996	err = noerror ; arg_idx = -1
997	help_req = .false.
998	DO WHILE(words_valid(cmd))
999	! get current element
1000	elt = words_current(cmd)
1001	! check element kind: is it an option flag (-1/0) or a value (1)?
1002	ic = ap_check_string(this,elt,arg_idx)
1003	IF (ic <= 0) THEN
1004	IF (arg_idx /= -1) THEN
1005	err = ap_fill_argument(this,cmd,this%args(arg_idx))
1006	IF (err == 0) THEN
1007	IF (this%args(arg_idx)%paction == ap_help) THEN
1008	this%parsed = 1
1009	err = argparser_get_value(this,'help',help_req)
1010	EXIT
1011	ELSE IF (this%args(arg_idx)%paction == ap_version) THEN
1012	this%parsed = 1
1013	err = argparser_get_value(this,'version',vers_req)
1014	EXIT
1015	ENDIF
1016	ENDIF
1017	IF (err /= 0) EXIT
1018	ELSE
1019	err = error("Unknown argument ('"//elt//"')",-9)
1020	EXIT
1021	ENDIF
1022	ELSE
1023	! We are in the positionals !!!
1024	IF (TRIM(elt) == '--') CALL words_next(cmd)
1025	EXIT
1026	ENDIF
1027	! iterates to next value
1028	CALL words_next(cmd)
1029	ENDDO
1030
1031	! Do we need to check for error here ?
1032	IF (err /= 0) THEN
1033	this%parsed = 0
1034	arg_idx = -1
1035	RETURN
1036	ELSE IF (help_req) THEN
1037	arg_idx = -1
1038	RETURN
1039	ENDIF
1040
1041	! Must check here for argument with append action if they have the correct
1042	! number of argument
1043	DO i=1,this%nargs
1044	nv = words_length(this%args(i)%values)
1045	IF (this%args(i)%fnd .AND. &
1046	this%args(i)%paction == ap_append .AND. &
1047	this%args(i)%nrec > 0 .AND. &
1048	nv /= this%args(i)%nrec) THEN
1049	IF (this%args(i)%nrec < nv) THEN
1050	err = ac_fmt_val_err(this%args(i),-18) ! extra values
1051	ELSE
1052	err = ac_fmt_val_err(this%args(i),-17) ! missing values
1053	ENDIF
1054	ENDIF
1055	ENDDO
1056	IF (err /= 0) this%parsed = 0
1057	RETURN
1058	END FUNCTION ap_parse_options
1059
1060	FUNCTION ap_parse_positionals(this,cmd) RESULT(err)
1061	!! Parse positional arguments of the internal command line
1062	!! This (internal) function manages the parsing of the command line positional arguments.
1063	OBJECT(argparser), INTENT(inout) :: this
1064	!! An argparser object reference
1065	TYPE(words), INTENT(inout) :: cmd
1066	!! A [[string_op(module):words(type)]] object with the command-line to parse
1067	TYPE(error) :: err
1068	!! Error object with the first error encountered in the process
1069	INTEGER :: na
1070	CHARACTER(len=:), ALLOCATABLE :: elt
1071	err = noerror
1072	! cmd iterator is located at the first positional argument
1073
1074	! no positional required but current word is valid
1075	! Either : no positional required but valid element is present
1076	! Or : positional required but no valid element is present
1077	IF ((this%have_posal.AND..NOT.words_valid(cmd)) .OR. &
1078	(.NOT.this%have_posal.AND.words_valid(cmd))) THEN
1079	err = error("Wrong number of arguments",-16) ; RETURN
1080	ENDIF
1081	! ugly patch : we must clear this%posals%values because of the automatic
1082	! setting of default value
1083	CALL words_clear(this%posals%values)
1084	this%posals%fnd = .true.
1085	DO
1086	na = words_length(this%posals%values)
1087	IF (words_valid(cmd)) THEN
1088	! Gets the element value
1089	elt = words_current(cmd)
1090	! and add it
1091	CALL words_append(this%posals%values,elt)
1092	ELSE
1093	! no more elements: check against the number of expected records
1094	! 1 or + elements expected but nothing has been saved
1095	IF (this%posals%nrec == -3 .AND. na > 1) THEN
1096	err = error("Extra value(s) found (positionals arguments)",-18)
1097	ELSE IF (this%posals%nrec == -2 .AND. na == 0) THEN
1098	err = error("Missing values (positionals arguments)",-17)
1099	ELSE IF (this%posals%nrec > 0 .AND. na /= this%posals%nrec) THEN
1100	IF (na > this%posals%nrec) THEN
1101	err = error("Extra value(s) found (positionals arguments)",-18)
1102	ELSE
1103	err = error("Missing values (positionals arguments)",-17)
1104	ENDIF
1105	ENDIF
1106	EXIT
1107	ENDIF
1108	! get to the next element
1109	CALL words_next(cmd)
1110	ENDDO
1111	IF (err /= noerror) THEN
1112	this%posals%fnd = .false.
1113	this%parsed = 0
1114	ENDIF
1115	RETURN
1116	END FUNCTION ap_parse_positionals
1117
1118	FUNCTION ap_fill_argument(this,cmd,arg) RESULT(err)
1119	!! Fill an argument with values
1120	!!
1121	!! The function parses remaining parts of the command line from the position of
1122	!! the given argument and attempts to retrieve its value(s) (if any).
1123	!! Several tests are performed and may raise errors. The function always stops
1124	!! at the first error encountered which can be one of the following :
1125	!! - Invalid value type (conversion check failed)
1126	!! - Missing values (can not get as much values as defined in the argument)
1127	!! - Extra values found (more values can be retrieved from the command line
1128	!! than defined in the argument)
1129	OBJECT(argparser), INTENT(inout) :: this
1130	!! An argparser object reference
1131	TYPE(words), INTENT(inout) :: cmd
1132	!! The command line
1133	TYPE(argc), INTENT(inout), TARGET :: arg
1134	!! An argc object reference with the argument currently processed.
1135	TYPE(error) :: err
1136	!! Error object with the first error encountered in the process
1137	INTEGER :: ca, isopt, itmp
1138	LOGICAL :: ltmp
1139	CHARACTER(len=:), ALLOCATABLE :: elt
1140	err = noerror
1141	! We always reset arguments value if we are in store mode.
1142	! If one wants to set an option several times and keeps track of the
1143	! previous values, she must use 'append'
1144	IF (arg%paction == ap_store) CALL words_clear(arg%values)
1145	! Gets values as a function of the expected number of records
1146	IF (arg%nrec == 0) THEN
1147	! argparser_parse (main parsing method) reset all values: for 0 nrec
1148	! we should have at least one value saved which is the default.
1149	! if it is not the case we set default as values of the argument
1150	IF (words_length(arg%values) == 0) CALL words_append(arg%values,arg%default)
1151	! NOW HANDLING 0 records case:
1152	! we do not have to consume any argument but :
1153	! - trigger a boolean (set it to .not.default)
1154	! - increase a counter (if action == 'count')
1155	IF (arg%paction == ap_count) THEN
1156	elt = words_pop(arg%values)
1157	READ(elt,*) itmp ; itmp = itmp + 1
1158	CALL words_append(arg%values,TO_STRING(itmp))
1159	ELSE IF (arg%ptype == ap_logical) THEN
1160	elt = words_pop(arg%values)
1161	READ(elt,*) ltmp
1162	CALL words_append(arg%values,TO_STRING(.NOT.ltmp))
1163	ENDIF
1164	ELSE
1165	! For any other case, the algorithm is quite simple :
1166	! We consume tokens of the command-line until either the end or
1167	! the next option (or '--' separator)
1168	! When the exit condition is met we perform some tests based on the
1169	! expected argument and sets the returned error object...
1170	ca = 0 ; IF(arg%paction == ap_append) ca = words_length(arg%values)
1171	DO
1172	CALL words_next(cmd) ; elt = words_current(cmd) ; isopt = ap_check_string(this,elt)
1173	! We have a "valid" value
1174	IF (((.NOT.words_valid(cmd)).EQV.(isopt<=0)).AND.TRIM(elt) /= '--') THEN
1175	! we have a value that we should check for conversion !
1176	err = ac_check_value(arg,elt)
1177	IF (err /= 0) THEN
1178	err = ac_fmt_val_err(arg,-2)
1179	ELSE
1180	CALL words_append(arg%values,elt) ; ca = ca + 1
1181	ENDIF
1182	ELSE
1183	! 3 cases are possible :
1184	! 1) we have consumed all argument of command line
1185	! 2) current argument is not a value !
1186	! 3) current argument the separator '--'
1187	IF (isopt <= 0 .OR. TRIM(elt)=='--') CALL words_previous(cmd)
1188	IF (arg%nrec == -2 .AND. words_length(arg%values) == 0) &
1189	err = ac_fmt_val_err(arg,-17)
1190	IF (arg%paction /= ap_append .AND. arg%nrec > 0 .AND. ca /= arg%nrec) &
1191	THEN
1192	IF (ca > arg%nrec) THEN
1193	err = ac_fmt_val_err(arg,-18)
1194	ELSE
1195	err = ac_fmt_val_err(arg,-17)
1196	ENDIF
1197	ENDIF
1198	EXIT
1199	ENDIF
1200	IF (err /= noerror) EXIT
1201	IF (arg%nrec == -3) EXIT
1202	IF (ca == arg%nrec) EXIT
1203	ENDDO
1204	ENDIF
1205	arg%fnd = (err == noerror)
1206	RETURN
1207	END FUNCTION ap_fill_argument
1208
1209	FUNCTION ap_split_cmd(this,string,new_cmd,rhelp) RESULT(err)
1210	!! Preprocess the command line
1211	!! The function reads and splits the given string so merged options/values
1212	!! are splitted and saves the resulting string elements in a list of words.
1213	!! @warning
1214	!! For compilers that does not support allocatable strings in derived types,
1215	!! computation are highly dependent of [[string_op(module):st_slen(variable):
1216	!! tokens length are limited by this parameter.
1217	IMPLICIT NONE
1218	OBJECT(argparser), INTENT(in) :: this
1219	!! An argparser object reference
1220	CHARACTER(len=*), INTENT(in) :: string
1221	!! A string to process
1222	TYPE(words), INTENT(out) :: new_cmd
1223	!! An output [[string_op(module):words(type)]] object with the processed command line
1224	LOGICAL, INTENT(out) :: rhelp
1225	!! An output boolean flag with `.true.` if help is requested, `.false.` otherwise
1226	TYPE(error) :: err
1227	!! Error object with the first error encountered in the process
1228	INTEGER :: isopt,j,tl,res
1229	CHARACTER(len=:), ALLOCATABLE :: elt
1230	TYPE(words) :: splitted
1231	INTEGER :: arg_idx
1232	err = noerror ; rhelp = .false.
1233	IF (LEN_TRIM(string) == 0) THEN
1234	err = error('internal error (empty string)',-255)
1235	RETURN
1236	ENDIF
1237	! split input command line in words !
1238	call words_extend(splitted,string," ",.true.)
1239	! reset iterator
1240	CALL words_reset(splitted)
1241	DO WHILE(words_valid(splitted))
1242	elt = words_current(splitted) ; tl = LEN_TRIM(elt)
1243	isopt = ap_check_string(this,TRIM(elt),arg_idx)
1244	! we have a short option : maybe we need to split it
1245	IF (isopt == -1 ) THEN
1246	DO j=2,tl
1247	res = ap_check_string(this,"-"//elt(j:j),arg_idx)
1248	! great we have another short option flag
1249	IF (res == -1 .AND. arg_idx /= -1) THEN ! another short option !
1250	rhelp = (this%args(arg_idx)%paction == ap_help.OR.rhelp)
1251	! we must not set some argument's values here for help argument
1252	! if auto is not set the parse method will disable the option
1253	! during next! parsing process
1254	CALL words_append(new_cmd,"-"//elt(j:j))
1255	ELSE
1256	IF (j == 2) THEN ! no more option flag !
1257	CALL words_append(new_cmd,TRIM(elt(j-1:)))
1258	ELSE
1259	CALL words_append(new_cmd,TRIM(elt(j:)))
1260	ENDIF
1261	EXIT ! WE MUST EXIT !!!!!!!
1262	ENDIF
1263	ENDDO
1264	ELSE
1265	IF (isopt == 0.AND.arg_idx /= -1) &
1266	rhelp = (this%args(arg_idx)%paction == ap_help.OR.rhelp)
1267	! we must not set some argument's values here for help argument
1268	! if auto is not set the parse method will disable the option during
1269	! next parsing process
1270	CALL words_append(new_cmd,TRIM(elt))
1271	ENDIF
1272	! Iterates to next word
1273	CALL words_next(splitted)
1274	ENDDO
1275	CALL words_clear(splitted)
1276	RETURN
1277	END FUNCTION ap_split_cmd
1278
1279	FUNCTION ap_check_string(this,string,idx) RESULT(ret)
1280	!! Check if a string is an option flag
1281	!! The function checks if the given string is either a short, long option flag or a value.
1282	!! @warning
1283	!! An empty string is considered as a value !
1284	OBJECT(argparser), INTENT(in) :: this
1285	!! An argparser object reference
1286	CHARACTER(len=*), INTENT(in) :: string
1287	!! A string to check
1288	INTEGER, INTENT(out), OPTIONAL :: idx
1289	!! An optional output intger with the index of the afferent argument in the parser (-1 if not found)
1290	INTEGER :: ret
1291	!! Return code with the following possible values:
1292	!! - -1 if the string is a SHORT option flag
1293	!! - 0 if the string is a LONG option flag
1294	!! - 1 if it considered as a value
1295	CHARACTER(len=52), PARAMETER :: alpha = "abcdefghijklmnopqrstuvwxyz&
1296	&ABCDEFGHIJKLMNOPQRSTUVWXYZ"
1297	! return code can be either :
1298	! -1 : it's a short option flag
1299	! 0 : it's a long option flag
1300	! 1 : it's a value
1301	! The combination of the (optional) output index and the return code
1302	! allows to check if an option is known or not
1303	ret = 1
1304	! '--' is special : it is a separator that is seen as a value.
1305	IF (TRIM(string) == '--') RETURN
1306	IF (PRESENT(idx)) idx = -1
1307	! First we will check the two first characters of the string
1308	IF (LEN_TRIM(string) >= 2) THEN
1309	IF (string(1:1) == ACHAR(45)) THEN
1310	! It's a long option flag !
1311	IF (string(2:2) == ACHAR(45)) THEN
1312	ret = 0
1313	IF (PRESENT(idx)) idx = ap_get_arg_index(this,lflag=TRIM(string))
1314	ELSE
1315	! It's a short option flag !
1316	IF (INDEX(alpha, string(2:2)) /= 0) THEN
1317	ret = -1
1318	IF (PRESENT(idx)) idx = ap_get_arg_index(this,sflag=string(1:2))
1319	ENDIF
1320	ENDIF
1321	ENDIF
1322	ENDIF
1323	RETURN
1324	END FUNCTION ap_check_string
1325
1326	FUNCTION ap_gen_help(this) RESULT(hlp)
1327	!! Generate the help string
1328	OBJECT(argparser), INTENT(inout) :: this
1329	!! An argparser object reference
1330	CHARACTER(len=:), ALLOCATABLE :: hlp
1331	!! The formatted help message
1332	CHARACTER(len=:), ALLOCATABLE :: copt,spc,opts,text
1333	INTEGER :: i,j,ia,optmw,i1,io,n,zw,zh
1334	IF (this%width == 0) CALL fs_termsize(zh,this%width)
1335	zw = this%width
1336	! Sets usage
1337	CALL ap_format_usage(this,optmw)
1338	! computes the help position
1339	optmw = optmw +2 + 2 ! +2 for indentation + 2 for spaces after option
1340	optmw = MIN(MAX(5,this%mxhlpos-1),optmw)
1341	hlp = TRIM(this%usg)//NEW_LINE('A')//NEW_LINE('A')
1342	! Sets description
1343	IF (LEN_TRIM(this%descr) /= 0) &
1344	hlp=hlp//getpar(this%descr,zw,2)//NEW_LINE('A')//NEW_LINE('A')
1345	! Sets positionals
1346	IF (this%have_posal) THEN
1347	IF (LEN_TRIM(this%posals%help) /= 0) THEN
1348	hlp=hlp//'positionals:'//NEW_LINE('A')
1349	copt = ac_get_opt_str(this%posals) ; n = LEN_TRIM(copt)
1350	hlp=hlp//getpar(copt,zw,idt1=2)
1351	! we must put help on a new line : no need to extends opt with spaces
1352	IF (n > optmw-2) THEN
1353	hlp=hlp//NEW_LINE('A')//REPEAT(CHAR(32),optmw)
1354	ELSE
1355	hlp=hlp//REPEAT(CHAR(32),optmw-n-2)
1356	ENDIF
1357	spc = REPEAT(CHAR(32),optmw)
1358	text = getpar(this%posals%help,zw-optmw,0,0)
1359	j=1
1360	DO WHILE(j <= LEN(text))
1361	i = INDEX(text(j:),NEW_LINE('A'))
1362	IF (i /= 0) THEN
1363	hlp=hlp//text(j:j+i-1)//spc
1364	j=j+i
1365	ELSE
1366	hlp=hlp//text(j:) ; EXIT
1367	ENDIF
1368	ENDDO
1369	hlp=hlp//NEW_LINE('A')//NEW_LINE('A')
1370	ENDIF
1371	ENDIF
1372	! Sets options
1373	IF (this%nargs > 0) THEN
1374	opts=''
1375	DO ia=1, this%nargs
1376	IF (LEN_TRIM(this%args(ia)%help) /= 0) THEN
1377	copt = ac_get_opt_str(this%args(ia)) ; n = LEN_TRIM(copt)
1378	opts=opts//getpar(copt,zw,idt1=2)
1379	! we must put help on a new line : no need to extends opt with spaces
1380	IF (n > optmw-2) THEN
1381	opts=opts//NEW_LINE('A')//REPEAT(CHAR(32),optmw)
1382	ELSE
1383	opts=opts//REPEAT(CHAR(32),optmw-n-2)
1384	ENDIF
1385	spc = REPEAT(CHAR(32),optmw)
1386	text = getpar(this%args(ia)%help,zw-optmw,0,0)
1387	j=1
1388	DO WHILE(j <= LEN(text))
1389	i = INDEX(text(j:),NEW_LINE('A'))
1390	IF (i /= 0) THEN
1391	opts=opts//text(j:j+i-1)//spc
1392	j=j+i
1393	ELSE
1394	opts=opts//text(j:) ; EXIT
1395	ENDIF
1396	ENDDO
1397	opts=opts//NEW_LINE('A')
1398	ENDIF
1399	ENDDO
1400	IF (LEN_TRIM(opts) > 0) hlp=hlp//'options:'//NEW_LINE('A')//opts
1401	ENDIF
1402	IF (LEN_TRIM(this%eplg) /= 0) THEN
1403	hlp=hlp//NEW_LINE('A')//getpar(this%eplg,zw,2)//NEW_LINE('A')
1404	ENDIF
1405	RETURN
1406	END FUNCTION ap_gen_help
1407
1408	SUBROUTINE ap_format_usage(this,optmw)
1409	!! Format command line usage.
1410	!!
1411	!! The subroutine creates and formats the command line usage of the
1412	!! given argparser object. If [[argparser(type):usg(variable)]] is already set (i.e. not empty)
1413	!! then the method only computes the maximum width of the option part of the usage command
1414	!! (see `optmw` argument description) if needed. In the other case, the method builds the usage
1415	!! line based on the arguments stored in the parser.
1416	OBJECT(argparser), INTENT(inout) :: this
1417	!! An argparser object reference
1418	INTEGER, INTENT(out), OPTIONAL :: optmw
1419	!! An optional integer with the maximum length of the option part of the usage command.
1420	!! This variable is intended to set a fancy indentation while printing option in the helper.
1421	CHARACTER(len=:), ALLOCATABLE :: usage, idts, copt,pgn
1422	INTEGER :: i,omw,idt,cl,wopt
1423	! Get/Checks/Sets maximum width
1424	! get program name
1425	pgn = get_progname()
1426	omw = 0
1427	IF (LEN_TRIM(this%usg) == 0) THEN
1428	idt = 8 + LEN_TRIM(pgn)
1429	ALLOCATE(CHARACTER(LEN=idt+1) :: idts)
1430	idts(1:1) = NEW_LINE('A') ; idts(2:idt+1) = CHAR(32)
1431	! Builds the usage string
1432	usage = "usage: "//TRIM(pgn)//CHAR(32)
1433	! Looping over arguments
1434	cl = idt
1435	DO i=1,this%nargs
1436	! gets max length for help options
1437	copt = ac_get_opt_str(this%args(i)) ; wopt=LEN_TRIM(copt)
1438	IF (LEN_TRIM(this%args(i)%help) /= 0.AND. wopt > omw) omw = wopt
1439	!IF (LEN_TRIM(copt) > omw) omw = LEN_TRIM(copt) ; copt=""
1440	! Retrieve current argument usage string
1441	copt = ac_get_usg_opt_str(this%args(i))
1442	! Set a new line if it does not hold width
1443	IF (cl+LEN_TRIM(copt) > this%width) THEN
1444	cl = idt ; usage = usage(:)//idts(:)
1445	ENDIF
1446	! Write the argument usage + a blank space !
1447	usage = usage(:)//TRIM(copt)//CHAR(32)
1448	cl = cl + LEN_TRIM(copt)+1
1449	ENDDO
1450	IF (PRESENT(optmw)) optmw = omw
1451	! handling positional
1452	IF (this%have_posal) THEN
1453	copt = ac_get_usg_opt_str(this%posals)
1454	IF (LEN_TRIM(copt) > 0) THEN
1455	! print newline if it cannot fit
1456	IF (cl+LEN_TRIM(copt) > this%width) usage = usage(:)//idts(:)
1457	usage = usage(:)//TRIM(copt)
1458	ENDIF
1459	ENDIF
1460	this%usg = usage
1461	ELSE
1462	IF (PRESENT(optmw)) THEN
1463	DO i=1,this%nargs
1464	copt = ac_get_opt_str(this%args(i)) ; wopt=LEN_TRIM(copt)
1465	IF (LEN_TRIM(this%args(i)%help) /= 0.AND.wopt > omw) omw = wopt
1466	copt = ""
1467	ENDDO
1468	optmw = omw
1469	ENDIF
1470	ENDIF
1471	END SUBROUTINE ap_format_usage
1472
1473	SUBROUTINE ap_affect_parser(this,other)
1474	!! Argparser assignment operator subroutine
1475	!! The subroutine assigns `other` to `this`
1476	TYPE(argparser), INTENT(out) :: this
1477	!! An argparser object to be assigned
1478	TYPE(argparser), INTENT(in) :: other
1479	!! An argparser object to assign
1480	INTEGER :: i
1481	IF (other%nargs > 0) THEN
1482	this%nargs = other%nargs
1483	ALLOCATE(this%args(this%nargs))
1484	DO i=1,this%nargs ; this%args(i) = other%args(i) ; ENDDO
1485	ENDIF
1486	this%have_posal = other%have_posal
1487	this%posals = other%posals
1488	this%parsed = other%parsed
1489	#if HAVE_FTNDTSTR
1490	IF (ALLOCATED(other%usg)) this%usg = other%usg
1491	IF (ALLOCATED(other%descr)) this%descr = other%descr
1492	IF (ALLOCATED(other%eplg)) this%eplg = other%eplg
1493	IF (ALLOCATED(other%vers)) this%vers = other%vers
1494	#else
1495	this%usg = other%usg
1496	this%descr = other%descr
1497	this%eplg = other%eplg
1498	this%vers = other%vers
1499	#endif
1500	this%mxhlpos = other%mxhlpos
1501	this%width = other%width
1502	this%init = other%init
1503	END SUBROUTINE ap_affect_parser
1504
1505	! argc methods
1506	! ------------
1507
1508	SUBROUTINE ac_affect_arg(this,other)
1509	!! Argc object assignment operator subroutine
1510	!! The subroutine assigns `other` to `this`
1511	TYPE(argc), INTENT(out) :: this
1512	!! An argc object to be assigned
1513	TYPE(argc), INTENT(in) :: other
1514	!! An argc object to assign
1515	this%nrec = other%nrec
1516	this%paction = other%paction
1517	this%ptype = other%ptype
1518	this%fnd = other%fnd
1519	this%sflag = other%sflag
1520	#if HAVE_FTNDTSTR
1521	IF (ALLOCATED(other%name)) this%name = other%name
1522	IF (ALLOCATED(other%lflag)) this%lflag = other%lflag
1523	IF (ALLOCATED(other%help)) this%help = other%help
1524	IF (ALLOCATED(other%default)) this%default = other%default
1525	#else
1526	this%name = other%name
1527	this%lflag = other%lflag
1528	this%default = other%default
1529	this%help = other%help
1530	#endif
1531	CALL words_clear(this%values)
1532	CALL words_clear(this%meta)
1533	this%values = other%values
1534	this%meta = other%meta
1535	RETURN
1536	END SUBROUTINE ac_affect_arg
1537
1538	FUNCTION ac_equals_arg(this,other) RESULT(ret)
1539	!! Check if two arguments are identical
1540	!! The method checks if two arguments are equal based on their name, short option flag and long
1541	!! option flag.Two arguments are considered equals if at least one of these three members is equal
1542	!! and not empty.
1543	TYPE(argc), INTENT(in) :: this
1544	!! First argc object to compare
1545	TYPE(argc), INTENT(in) :: other
1546	!! Second argc object to compare
1547	LOGICAL :: ret
1548	!! `.true.` if the two objects are equal, `.false.` otherwise.
1549	CHARACTER(len=:), ALLOCATABLE :: tna,ona,tsf,osf,tlf,olf
1550	INTEGER :: tn,ts,tl,on,os,ol
1551	ret = .false.
1552	tsf = TRIM(this%sflag) ; osf = TRIM(this%sflag)
1553	#if HAVE_FTNDTSTR
1554	tna="" ; IF (ALLOCATED(this%name)) tna=TRIM(this%name)
1555	ona="" ; IF (ALLOCATED(other%name)) ona=TRIM(other%name)
1556	tlf="" ; IF (ALLOCATED(this%lflag)) tlf=TRIM(this%lflag)
1557	olf="" ; IF (ALLOCATED(other%lflag)) olf=TRIM(other%lflag)
1558	#else
1559	tna=TRIM(this%name) ; ona=TRIM(other%name)
1560	tlf=TRIM(this%lflag) ; olf=TRIM(other%lflag)
1561	#endif
1562	tn=LEN_TRIM(tna) ; on=LEN_TRIM(ona)
1563	tl=LEN_TRIM(tlf) ; ol=LEN_TRIM(olf)
1564	ts=LEN_TRIM(tsf) ; os=LEN_TRIM(osf)
1565	! check on name :
1566	! Returns True if at least of name, sflag and lflag is set to non-empty
1567	! string and is indentical for the two argument !
1568	ret = ((tn/=0 .AND. on==tn) .AND. tna == ona) .OR. &
1569	((tl/=0 .AND. ol==tl) .AND. tlf == olf) .OR. &
1570	((ts/=0 .AND. os==ol) .AND. tsf == osf)
1571	DEALLOCATE(tna,ona,tsf,osf,tlf,olf)
1572	END FUNCTION ac_equals_arg
1573
1574	FUNCTION ac_differs_arg(this,other) RESULT(ret)
1575	!! Check if two arguments are different
1576	!! The method checks if two arguments are different based on their names, short option flag
1577	!! and long option flag.
1578	!! @note
1579	!! This function is the extact contrary of [[argparse(module):ac_equals_arg(function)]] !
1580	TYPE(argc), INTENT(in) :: this
1581	!! First argc object to compare
1582	TYPE(argc), INTENT(in) :: other
1583	!! Second argc object to compare
1584	LOGICAL :: ret
1585	!! `.true.` if the two objects are different, `.false.` otherwise.
1586	ret = .NOT. ac_equals_arg(this,other)
1587	END FUNCTION ac_differs_arg
1588
1589	SUBROUTINE ac_clear_arg_sc(arg)
1590	!! argc destructor (scalar)
1591	!! The subroutine frees all memory used by an argc object and resets its member to
1592	!! default values.
1593	TYPE(argc), INTENT(inout) :: arg
1594	!! An argc object to free
1595	CALL words_clear(arg%values)
1596	CALL words_clear(arg%meta)
1597	arg%ptype = ap_logical
1598	arg%paction = ap_store
1599	arg%nrec = 0
1600	arg%fnd = .false.
1601	arg%sflag = " "
1602	#if HAVE_FTNDTSTR
1603	IF (ALLOCATED(arg%default)) DEALLOCATE(arg%default)
1604	IF (ALLOCATED(arg%name)) DEALLOCATE(arg%name)
1605	IF (ALLOCATED(arg%lflag)) DEALLOCATE(arg%lflag)
1606	IF (ALLOCATED(arg%help)) DEALLOCATE(arg%help)
1607	#else
1608	arg%default = ""
1609	arg%name = ""
1610	arg%help = ""
1611	arg%lflag = ""
1612	#endif
1613	END SUBROUTINE ac_clear_arg_sc
1614
1615	SUBROUTINE ac_clear_arg_ve(args)
1616	!! argc destructor (vector)
1617	TYPE(argc), INTENT(inout), DIMENSION(:), TARGET :: args
1618	!! A vector of argc objects to free
1619	INTEGER :: i
1620	CALL words_clear(args%values)
1621	CALL words_clear(args%meta)
1622	DO i=1, SIZE(args)
1623	args(i)%ptype = ap_logical
1624	args(i)%paction = ap_store
1625	args(i)%nrec = 0
1626	args(i)%fnd = .false.
1627	args(i)%sflag = " "
1628	#if HAVE_FTNDTSTR
1629	IF (ALLOCATED(args(i)%default)) DEALLOCATE(args(i)%default)
1630	IF (ALLOCATED(args(i)%name)) DEALLOCATE(args(i)%name)
1631	IF (ALLOCATED(args(i)%lflag)) DEALLOCATE(args(i)%lflag)
1632	IF (ALLOCATED(args(i)%help)) DEALLOCATE(args(i)%help)
1633	#else
1634	args(i)%default = ""
1635	args(i)%name = ""
1636	args(i)%help = ""
1637	args(i)%lflag = ""
1638	#endif
1639	ENDDO
1640	END SUBROUTINE ac_clear_arg_ve
1641
1642	FUNCTION ac_found(this) RESULT(yes)
1643	!! Check if argument has been found in the command line
1644	TYPE(argc), INTENT(in) :: this
1645	!! An argc object
1646	LOGICAL :: yes
1647	!! `.true.` if the option has been parsed, `.false.` otherwise
1648	yes = this%fnd
1649	END FUNCTION ac_found
1650
1651	FUNCTION ac_get_num_values(this) RESULT(num)
1652	!! Get the actual number of values stored in the argument
1653	TYPE(argc), INTENT(in) :: this
1654	!! An argc object
1655	INTEGER :: num
1656	!! The number of values stored in the argument
1657	num = words_length(this%values)
1658	END FUNCTION ac_get_num_values
1659
1660	FUNCTION ac_get_usg_opt_str(arg) RESULT(line)
1661	!! Build and format the option string for the usage part of the help message
1662	!! The function is private part of the help builder. It creates the
1663	!! option string part of a given argument.
1664	TYPE(argc), INTENT(in), TARGET :: arg
1665	!! An argc object
1666	CHARACTER(len=:), ALLOCATABLE :: line,meta
1667	!! Allocated string with the option flags string
1668	line=""
1669	IF (LEN_TRIM(arg%sflag) > 0) THEN
1670	line="["//TRIM(arg%sflag)
1671	ELSE IF (LEN_TRIM(arg%lflag) > 0) THEN
1672	line="["//TRIM(arg%lflag)
1673	ENDIF
1674	meta = TRIM(words_get(arg%meta,1))
1675	SELECT CASE (arg%nrec)
1676	CASE (-3)
1677	line=line(:)//" ["//meta//"]"
1678	CASE (-2)
1679	line=line(:)//CHAR(32)//meta//" [...]"
1680	CASE (-1)
1681	line=line(:)//" ["//meta//" [...]]"
1682	CASE (0)
1683	! DO NOTHING BUT MUST BE EXPLICITELY SET
1684	CASE DEFAULT
1685	meta = words_to_string(arg%meta," ")
1686	line = line(:)//CHAR(32)//meta
1687	END SELECT
1688	IF (line(1:1) == "[") line=line(:)//"]"
1689	RETURN
1690	END FUNCTION ac_get_usg_opt_str
1691
1692	FUNCTION ac_get_opt_str(arg) RESULT(line)
1693	!! Build and format the option flag string for the option part of the help message
1694	!! The function is private part of the help builder. It creates the
1695	!! option string part of a given argument for the options part of the help.
1696	TYPE(argc), INTENT(in), TARGET :: arg
1697	!! An argc object
1698	CHARACTER(len=:), ALLOCATABLE :: line
1699	!! Allocated string with the option flags string
1700	CHARACTER(len=:), ALLOCATABLE :: values,m
1701	! creates values string
1702	m = TRIM(words_get(arg%meta,1))
1703	SELECT CASE (arg%nrec)
1704	CASE(-3)
1705	values="["//m//"]"
1706	CASE(-2)
1707	values=m//" [...]"
1708	CASE(-1)
1709	values="["//m//" [...]]"
1710	CASE (0)
1711	values=""
1712	CASE DEFAULT
1713	values = words_to_string(arg%meta," ")
1714	END SELECT
1715	! build the final string
1716	! -s values, --long values
1717	line=""
1718	IF (LEN_TRIM(arg%sflag) > 0) THEN
1719	line=TRIM(arg%sflag)//CHAR(32)//TRIM(values)
1720	IF (LEN_TRIM(arg%lflag) > 0) line = line(:)//", "
1721	ENDIF
1722	IF (LEN_TRIM(arg%lflag) > 0) THEN
1723	line = line(:)//TRIM(arg%lflag)//CHAR(32)//TRIM(values)
1724	ENDIF
1725	! this line handles positionals :)
1726	IF (arg%name == 'positional') line = TRIM(values)
1727	RETURN
1728	END FUNCTION ac_get_opt_str
1729
1730	FUNCTION ac_fmt_val_err(arg,id) RESULT(ret)
1731	!! Format specific error for argc values
1732	!! The function formats argparse specific errors when extra (missing) values
1733	!! are (not) set or when given values are not consistent with argument's type.
1734	!! For each of these errors, the basic error is updated with a more precise
1735	!! message.
1736	TYPE(argc), INTENT(in) :: arg
1737	!! An argc object
1738	INTEGER, INTENT(in) :: id
1739	!! Integer with the error id (-3, -15 or -16 in fact)
1740	TYPE(error) :: ret
1741	!! Error object with the updated error message.
1742	CHARACTER(len=:), ALLOCATABLE :: msg,nv
1743	IF (LEN_TRIM(arg%sflag) /= 0) THEN
1744	msg=' ('//arg%sflag
1745	ELSE ! note that normally if no sflag are present lflag should be set
1746	msg=' ('//TRIM(arg%lflag)
1747	ENDIF
1748	nv = to_string(arg%nrec) ; IF (arg%nrec < 0) nv='1'
1749	! we only handle ids : -2 (invalid arg), -17 (missing values), -18 (extra values)
1750	SELECT CASE(id)
1751	CASE (-2) ! invalid value: cannot cast ->
1752	msg = msg//" option expects '"//apt2str(arg%ptype)//"' values)"
1753	CASE (-17) ! missing values -> -17
1754	IF (arg%nrec == -2) THEN
1755	msg = msg//' takes at least '//nv//' value(s))'
1756	ELSE
1757	msg = msg//' takes exactly '//nv//' value(s))'
1758	ENDIF
1759	CASE (-18) ! extra values -> -18
1760	IF (arg%nrec == -3) THEN
1761	msg = msg//' takes at most '//nv//' value(s))'
1762	ELSE
1763	msg = msg//' takes exactly '//nv//' value(s))'
1764	ENDIF
1765	CASE DEFAULT
1766	msg=''
1767	END SELECT
1768	ret = error(msg,id)
1769	END FUNCTION ac_fmt_val_err
1770
1771	FUNCTION ac_check_and_set(this,sf,lf,ty,ac,de,na,meta,check_flag) RESULT(ret)
1772	!! Interface to all argc's member tests
1773	!! The function calls all the tests to perform on argc members. Some of these tests can
1774	!! alter argc's member values to fit argparser's requirements.
1775	!!
1776	!! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
1777	!! produced by misuse of the function arguments. In such case, the program should be
1778	!! stopped: note that such ezrror should not occur in _released_ programs.
1779	TYPE(argc), INTENT(inout) :: this
1780	!! An argc object
1781	CHARACTER(len=2), INTENT(in) :: sf
1782	!! A string (2 chars wide) with the short option flag
1783	CHARACTER(len=*), INTENT(in) :: lf
1784	!! A string with the long option flag
1785	INTEGER, INTENT(in) :: ty
1786	!! An integer with the type of the argument
1787	INTEGER, INTENT(in) :: ac
1788	!! An integer with the action of the argument
1789	CHARACTER(len=*), INTENT(in) :: de
1790	!! A string with the default value of the argument
1791	CHARACTER(len=*), INTENT(in) :: na
1792	!! A string pattern with the expected number of values for the argument
1793	CHARACTER(len=*), INTENT(in), DIMENSION(:), OPTIONAL :: meta
1794	!! An optional vector of strings with the Meta-name of the values
1795	LOGICAL, INTENT(in), OPTIONAL :: check_flag
1796	!! An optional boolean flag hat instructs the method wether to check for option flag
1797	!! or not. By default this test is enabled but it should be disabled if one wants to
1798	!! check for POSITIONAL arguments as they do not have option flags.
1799	TYPE(error) :: ret
1800	!! Error object with the first error encountered in the process
1801	LOGICAL :: zflag
1802	zflag = .true. ; IF (PRESENT(check_flag)) zflag = check_flag
1803	! 1) CHECKING FLAG SYNTAX
1804	IF (zflag) THEN
1805	ret = ac_check_flags(this,sf,lf) ; IF (ret /= 0) RETURN
1806	ELSE
1807	this%sflag = sf ; this%lflag = lf
1808	ENDIF
1809	! 2) CHECKING AND SETTING action, type, default value and number of record
1810	ret = ac_check_ac_ty_de_na(this,ac,ty,de,na) ; IF (ret /= 0) RETURN
1811	! 3) Sets/updates meta name
1812	IF (PRESENT(meta)) THEN
1813	CALL ac_set_meta(this,meta)
1814	ELSE
1815	CALL ac_set_meta(this)
1816	ENDIF
1817	RETURN
1818	END FUNCTION ac_check_and_set
1819
1820	FUNCTION ac_check_ac_ty_de_na(this,ac,ty,de,na) RESULT(ret)
1821	!! Check and set argc's action, type and default value
1822	!! The method checks if input argument's options are valid and update the argc object
1823	!! consequently.
1824	!!
1825	!! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
1826	!! produced by misuse of the function arguments.
1827	TYPE(argc), INTENT(inout) :: this
1828	!! An argc object to update
1829	INTEGER, INTENT(in) :: ac
1830	!! An integer with the action to set and check
1831	INTEGER, INTENT(in) :: ty
1832	!! An integer with the type to set and check
1833	CHARACTER(len=*), INTENT(in) :: de
1834	!! A string with the default value to set and check
1835	CHARACTER(len=*), INTENT(in) :: na
1836	!! A string with the expected number of value to set and check
1837	TYPE(error) :: ret
1838	!! Error object with the first error encountered in the process
1839	CHARACTER(len=:), ALLOCATABLE :: eprf,zna
1840	TYPE(error) :: uty,ina
1841	ret = noerror
1842	eprf = 'argparse: '//"Invalid argument `"//TRIM(this%name)//"'"
1843	uty = error(eprf//" (type)",-9)
1844	ina = error(eprf//" (inconsistent nargs)",-9)
1845	zna = TRIM(na)
1846	! Checks action
1847	IF(ANY(ap_actions == ac).OR.ac == ap_undef) THEN
1848	this%paction = ac
1849	ELSE
1850	ret = error(eprf//" (action)",-9) ; RETURN
1851	ENDIF
1852	! Checks and sets type and default as a function of the action
1853	SELECT CASE(this%paction)
1854	! HELP: fixed in any case:
1855	CASE(ap_help)
1856	this%default = 'F'
1857	this%ptype = ap_logical
1858	this%nrec = 0
1859	! VERSION: fixed in any case:
1860	CASE(ap_version)
1861	this%default = 'F'
1862	this%ptype = ap_logical
1863	this%nrec = 0
1864	! COUNT:
1865	! we always use "hard-coded" stuff and do not warn if dev has made mistakes...
1866	CASE(ap_count)
1867	! default settings of the count action
1868	this%ptype = ap_integer ; this%default = '0' ; this%nrec = 0
1869	! check and set default value
1870	ret = set_def_val()
1871	! STORE, APPEND actions
1872	CASE (ap_store, ap_append)
1873	! set type
1874	IF (ty == ap_undef) THEN
1875	this%ptype= ap_integer
1876	ELSEIF (ANY(ap_types == ty)) THEN
1877	this%ptype = ty
1878	ELSE
1879	ret = uty ; RETURN
1880	ENDIF
1881	! check and set default value
1882	ret = set_def_val() ; IF (ret /= 0) RETURN
1883	! check for nargs (if na is empty then we set "*")
1884	ret = set_nrec("*")
1885	! UNDEFINED:
1886	! -> 1) set to action to store
1887	! ->
1888	! try to define a logical trigger and modifies it with user-defined
1889	! characteristics
1890	CASE (ap_undef)
1891	! 1) always define store action
1892	this%paction = ap_store
1893	! 2) set type and nrec:
1894	! 2.1) If type is undef:
1895	! - to default value type if default is given
1896	! - ap_logical otherwiset type
1897	! 2.2) set nrec
1898	! - if final type is ap_logical set nrec to 0
1899	! - otherwise to *
1900	If (ty == ap_undef) THEN
1901	! no explicit type : define logical trigger first
1902	this%ptype = ap_logical ; this%nrec = 0
1903	! icheck the default value given
1904	IF (LEN_TRIM(de) > 0) THEN
1905	this%ptype = ap_types(string_is(de)+1)
1906	ELSE
1907	this%ptype = ap_logical
1908	ENDIF
1909	IF (this%ptype == ap_logical) THEN
1910	ret = set_nrec("0")
1911	ELSE
1912	ret = set_nrec("1")
1913	ENDIF
1914	ret = set_def_val()
1915	IF (ret /= 0) RETURN
1916	! type is given
1917	ELSE IF (ANY(ty == ap_types)) THEN
1918	! known type given :
1919	! check default value and nrec: -> if na not given set "*"
1920	this%ptype = ty
1921	ret = set_def_val() ; IF (ret /= 0) RETURN
1922	IF (this%ptype == ap_logical) THEN
1923	ret = set_nrec("0")
1924	ELSE
1925	ret = set_nrec("1")
1926	ENDIF
1927	ELSE
1928	! unknown type => bad end !
1929	ret = uty ; RETURN
1930	ENDIF
1931	END SELECT
1932	! set default value as first value if ret is noerror ....
1933	IF (ret == 0) CALL words_append(this%values,this%default)
1934	RETURN
1935
1936	CONTAINS
1937
1938	FUNCTION set_nrec(base) RESULT(terr)
1939	!! Check and set argument's expected number of records
1940	!! The method compares `na` value with the expected and known flags and decides
1941	!! wether to raise an error or defines nrec member of the argument object. If `na`
1942	!! is empty then `base` is used.
1943	CHARACTER(len=1),INTENT(in) :: base
1944	!! Base value of nrec
1945	TYPE(error) :: terr
1946	!! Error object with the return status of the function
1947	terr = noerror
1948	! check for nargs:
1949	IF (LEN(zna) == 0) zna=base
1950	SELECT CASE(zna)
1951	CASE("*") ; this%nrec = -1
1952	CASE("+") ; this%nrec = -2
1953	CASE("?") ; this%nrec = -3
1954	IF (this%paction == ap_append) terr = ina
1955	CASE DEFAULT ; this%nrec = 0
1956	! check numeric characters
1957	IF (VERIFY(zna,"0123456789")==0) READ(zna,*) this%nrec
1958	IF (this%nrec == 0) terr = ina
1959	END SELECT
1960	END FUNCTION set_nrec
1961
1962	FUNCTION set_def_val() RESULT(terr)
1963	!! Check and set argument's default value
1964	!! The method compares `de` value with the type already stored in the argument and
1965	!! decides wether to raise an error or to save `de` as argument's default value.
1966	!! If `de` is empty then it sets a default value according to argument's type.
1967	TYPE(error) :: terr
1968	!! Error object with the return status of the function
1969	INTEGER :: t
1970	terr = noerror
1971	IF (LEN_TRIM(de) /= 0) THEN
1972	this%default = de ; t = string_is(de)
1973	IF (t /= this%ptype) THEN
1974	terr = error(eprf//" (inconsistent default value: expected '"// &
1975	TRIM(st_type_names(this%ptype))//"', found '"// &
1976	TRIM(st_type_names(t))//"')",-9)
1977	RETURN
1978	ENDIF
1979	ELSE
1980	SELECT CASE (this%ptype)
1981	CASE(ap_string) ; this%default = ''
1982	CASE(ap_logical) ; this%default = 'F'
1983	CASE(ap_complex) ; this%default = '(0d0,0d0)'
1984	CASE(ap_integer) ; this%default = '0'
1985	CASE(ap_real) ; this%default = '0d0'
1986	END SELECT
1987	ENDIF
1988	RETURN
1989	END FUNCTION set_def_val
1990	END FUNCTION ac_check_ac_ty_de_na
1991
1992	FUNCTION ac_check_flags(this,sflag,lflag) RESULT(ret)
1993	!! Set and check if argument's option flags are valid
1994	!! The method first sets the given flags in the argc object and then checks if
1995	!! its option flags are valid :
1996	!! - A valid short option flag (`sflag`) starts with `-' followed by the
1997	!! regex pattern : @p [a-zA-Z]
1998	!! - A valid long option flag (`lflag`) starts with `--' followed by the
1999	!! regex pattern : @p [-a-zA-Z_0-9]+
2000	!! @note
2001	!! Although the two arguments are mandatory one can be an empty string
2002	TYPE(argc), INTENT(inout) :: this
2003	!! An argc object
2004	CHARACTER(len=2), INTENT(in) :: sflag
2005	!! A 2-characters wide string with the short option flag
2006	CHARACTER(len=*), INTENT(in) :: lflag
2007	!! A string (at least 3 characters wide) with the long option flag
2008	TYPE(error) :: ret
2009	!! Error object with the first error encountered in the process
2010	INTEGER :: ic
2011	ret = noerror
2012	this%sflag = sflag ; this%lflag = lflag
2013	! 1) Check null strings !
2014	IF (LEN_TRIM(this%sflag) == 0 .AND. LEN_TRIM(this%lflag) == 0) THEN
2015	ret = error("argparse: Invalid argument (empty option flags)",-2) ; RETURN
2016	ENDIF
2017	! 2) Check short option flag:
2018	IF (LEN_TRIM(this%sflag) > 0) THEN
2019	IF (this%sflag(1:1) /= achar(45)) THEN
2020	ret = error("argparse: Invalid argument (short option)",-2) ; RETURN
2021	ELSE
2022	SELECT CASE(iachar(this%sflag(2:2)))
2023	CASE(97:122,65:90) ; ret = noerror
2024	CASE DEFAULT
2025	ret = error("argparse: Invalid argument (short option)",-2) ; RETURN
2026	END SELECT
2027	ENDIF
2028	ENDIF
2029	! 3) Check long option flag
2030	IF (LEN_TRIM(this%lflag) > 0) THEN
2031	! We must have at least 3 chars !
2032	IF (LEN_TRIM(this%lflag) < 3) THEN
2033	ret = error("argparse: Invalid argument (long option)",-2) ; RETURN
2034	ELSE IF (this%lflag(1:2) /= achar(45)//achar(45)) THEN
2035	ret = error("argparse: Invalid argument (long option)",-2) ; RETURN
2036	ELSE
2037	DO ic=3,LEN_TRIM(this%lflag)
2038	SELECT CASE(iachar(this%lflag(ic:ic)))
2039	! corresponds to [-a-zA-Z0-9_]
2040	CASE(45,48:57,65:90,95,97:122) ; ret = noerror
2041	CASE DEFAULT
2042	ret = error("argparse: Invalid argument (long option)",-2) ; RETURN
2043	EXIT
2044	END SELECT
2045	ENDDO
2046	ENDIF
2047	ENDIF
2048	RETURN
2049	END FUNCTION ac_check_flags
2050
2051	SUBROUTINE ac_set_meta(this, meta)
2052	!! Set meta-variable of the given argc object
2053	!! The method set meta-variable in the argc object. If no `meta` are given, the method
2054	!! uses argument's name to set the values.
2055	!! @warning
2056	!! To be effective, this subroutine must be called after argparse::chk_opt_nargs
2057	TYPE(argc), INTENT(inout) :: this
2058	!! An argc object reference
2059	CHARACTER(len=*), INTENT(in), DIMENSION(:), OPTIONAL :: meta
2060	!! An optional vector of strings with the meta-variable(s) to set
2061	INTEGER :: i,j,ms,blk
2062	CHARACTER(len=:), ALLOCATABLE :: zmeta
2063	! clear meta values (not needed normally)
2064	CALL words_clear(this%meta)
2065	IF (PRESENT(meta)) THEN
2066	SELECT CASE(this%nrec)
2067	CASE(-3,-2,-1)
2068	zmeta = to_upper(meta(1))
2069	blk = INDEX(TRIM(zmeta),CHAR(32)) - 1
2070	IF (blk <= 0) blk=LEN_TRIM(zmeta)
2071	CALL words_append(this%meta,zmeta(1:blk))
2072	CASE(0)
2073	CALL words_append(this%meta,"")
2074	CASE DEFAULT
2075	ms = SIZE(meta) ; j = 0
2076	DO i=1,this%nrec
2077	j=j+1 ; IF (j>ms) j=1
2078	zmeta = to_upper(meta(j))
2079	blk=INDEX(TRIM(zmeta),CHAR(32))-1
2080	IF (blk <= 0) blk=LEN_TRIM(zmeta)
2081	CALL words_append(this%meta,zmeta(1:blk))
2082	ENDDO
2083	END SELECT
2084	ELSE
2085	zmeta = to_upper(TRIM(this%name))
2086	SELECT CASE(this%nrec)
2087	CASE(-3,-2,-1)
2088	CALL words_append(this%meta,zmeta)
2089	CASE DEFAULT
2090	DO i=1,this%nrec
2091	CALL words_append(this%meta,zmeta)
2092	ENDDO
2093	END SELECT
2094	ENDIF
2095	RETURN
2096	END SUBROUTINE ac_set_meta
2097
2098	FUNCTION ac_check_value(this,str) RESULT(err)
2099	!! Check if given string is a valid value for the argument
2100	TYPE(argc), INTENT(in) :: this
2101	!! An argc object reference
2102	CHARACTER(len=*), INTENT(in) :: str
2103	!! A string with the value to check
2104	TYPE(error) :: err
2105	!! Error object with the first error encountered in the process
2106	INTEGER :: ty
2107	err = noerror
2108	! Special conditions for strings: any kind of value is ok if we asked for
2109	! strings
2110	IF (this%ptype == ap_string) RETURN
2111	ty = string_is(str)
2112	! special handling for integer: they can be seen as real
2113	IF (this%ptype == ap_real) THEN
2114	IF (ty < 3) err = error("Cannot cast value",-10)
2115	ELSE
2116	IF (ty /= this%ptype) err = error("Cannot cast value",-10)
2117	ENDIF
2118	RETURN
2119	END FUNCTION ac_check_value
2120
2121	!===========
2122	! GETTERS
2123	!===========
2124
2125	! argparser getters
2126	! -----------------
2127
2128	FUNCTION ap_get_positional_sc(this,idx,value) RESULT(ret)
2129	!! Get positional arguments value at given index
2130	!! @warning
2131	!! On error, the status of `value` is undefined.
2132	OBJECT(argparser), INTENT(in) :: this
2133	!! An argparser object reference
2134	INTEGER, INTENT(in) :: idx
2135	!! Subscript of the positional argument value to get
2136	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: value
2137	!! Output raw value of the positional. If `idx` is out of range, `value` is set to an
2138	!! empty string.
2139	TYPE(error) :: ret
2140	!! Error object with the first error encountered in the process
2141	IF (.NOT.this%have_posal) THEN
2142	ret = error("argparse: No positional argument(s) defined",-7)
2143	ELSE IF (idx <= 0 .OR. idx > words_length(this%posals%values)) THEN
2144	ret = error("argparse: index out of range", -3)
2145	ELSE
2146	value = words_get(this%posals%values,idx)
2147	ret = noerror
2148	ENDIF
2149	RETURN
2150	END FUNCTION ap_get_positional_sc
2151
2152	FUNCTION ap_get_positional_ve(this,values) RESULT(ret)
2153	!! Get all positional arguments value
2154	!! @warning
2155	!! On error, the status of `values` is undefined.
2156	OBJECT(argparser), INTENT(in) :: this
2157	!! An argparser object reference
2158	CHARACTER(len=st_slen), INTENT(out), ALLOCATABLE, DIMENSION(:) :: values
2159	!! An allocatable vector of assumed length strings with the value(s) of all
2160	!! positionals arguments found.
2161	TYPE(error) :: ret
2162	!! Error object with the first error encountered in the process
2163	LOGICAL :: ok
2164	ret = noerror
2165	IF (.NOT.this%have_posal) THEN
2166	ret = error("argparse: No positional argument(s) defined",-7)
2167	ELSE IF (words_length(this%posals%values) == 0) THEN
2168	ret = error("argparse: No positional argument(s) values found",-6)
2169	ELSE
2170	ok = words_to_vector(this%posals%values,values)
2171	ENDIF
2172	RETURN
2173	END FUNCTION ap_get_positional_ve
2174
2175	FUNCTION ap_get_dv_sc(this, name, output) RESULT(ret)
2176	!! Get a scalar `REAL(kind=8)` value from given argument
2177	!! The error returned by the method can be either:
2178	!! - 0 : No error
2179	!! - -1 : parser has not been initialized
2180	!! - -7 : argument not found (i.e. does not set in the parser)
2181	!! - -19 : parsing not done yet
2182	!! - -20 : (previous) parsing failed
2183	!! - -21 : inconsistent destination type
2184	!! @note
2185	!! If no error occured, the function always set a value which is the default value
2186	!! if the argument has not been parsed. Otherwise, `output` value is undefined.
2187	OBJECT(argparser), INTENT(in) :: this
2188	!! An argparser object reference
2189	CHARACTER(len=*), INTENT(in) :: name
2190	!! Name of the argument
2191	REAL(kind=8), INTENT(out) :: output
2192	!! A scalar with the first value of the argument
2193	TYPE(error) :: ret
2194	!! Error object with the first error encountered in the process
2195	INTEGER :: idx
2196	ret = ap_check_state(this)
2197	IF (ret == 0) THEN
2198	idx = ap_get_arg_index(this,name)
2199	IF (idx == -1) THEN
2200	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2201	ELSE
2202	ret = argc_get_value(this%args(idx),output)
2203	ENDIF
2204	ENDIF
2205	RETURN
2206	END FUNCTION ap_get_dv_sc
2207
2208	FUNCTION ap_get_rv_sc(this, name, output) RESULT(ret)
2209	!! Get a scalar `REAL(kind=4)` value from given argument
2210	!! The error returned by the method can be either:
2211	!! - 0 : No error
2212	!! - -1 : parser has not been initialized
2213	!! - -7 : argument not found (i.e. does not set in the parser)
2214	!! - -19 : parsing not done yet
2215	!! - -20 : (previous) parsing failed
2216	!! - -21 : inconsistent destination type
2217	!! @note
2218	!! If no error occured, the function always set a value which is the default value
2219	!! if the argument has not been parsed. Otherwise, `output` value is undefined.
2220	OBJECT(argparser), INTENT(in) :: this
2221	!! An argparser object reference
2222	CHARACTER(len=*), INTENT(in) :: name
2223	!! Name of the argument
2224	REAL(kind=4), INTENT(out) :: output
2225	!! A scalar with the first value of the argument
2226	TYPE(error) :: ret
2227	!! Error object with the first error encountered in the process
2228	INTEGER :: idx
2229	ret = ap_check_state(this)
2230	IF (ret == 0) THEN
2231	idx = ap_get_arg_index(this,name)
2232	IF (idx == -1) THEN
2233	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2234	ELSE
2235	ret = argc_get_value(this%args(idx),output)
2236	ENDIF
2237	ENDIF
2238	RETURN
2239	END FUNCTION ap_get_rv_sc
2240
2241	FUNCTION ap_get_iv_sc(this, name, output) RESULT(ret)
2242	!! Get a scalar `INTEGER` value from given argument
2243	!! The error returned by the method can be either:
2244	!! - 0 : No error
2245	!! - -1 : parser has not been initialized
2246	!! - -7 : argument not found (i.e. does not set in the parser)
2247	!! - -19 : parsing not done yet
2248	!! - -20 : (previous) parsing failed
2249	!! - -21 : inconsistent destination type
2250	!! @note
2251	!! If no error occured, the function always set a value which is the default value
2252	!! if the argument has not been parsed. Otherwise, `output` value is undefined.
2253	OBJECT(argparser), INTENT(in) :: this
2254	!! An argparser object reference
2255	CHARACTER(len=*), INTENT(in) :: name
2256	!! Name of the argument
2257	INTEGER, INTENT(out) :: output
2258	!! A scalar with the first value of the argument
2259	TYPE(error) :: ret
2260	!! Error object with the first error encountered in the process
2261	INTEGER :: idx
2262	ret = ap_check_state(this)
2263	IF (ret == 0) THEN
2264	idx = ap_get_arg_index(this,name)
2265	IF (idx == -1) THEN
2266	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2267	ELSE
2268	ret = argc_get_value(this%args(idx),output)
2269	ENDIF
2270	ENDIF
2271	RETURN
2272	END FUNCTION ap_get_iv_sc
2273
2274	FUNCTION ap_get_lv_sc(this, name, output) RESULT(ret)
2275	!! Get a scalar `LOGICAL` value from given argument
2276	!! The error returned by the method can be either:
2277	!! - 0 : No error
2278	!! - -1 : parser has not been initialized
2279	!! - -7 : argument not found (i.e. does not set in the parser)
2280	!! - -19 : parsing not done yet
2281	!! - -20 : (previous) parsing failed
2282	!! - -21 : inconsistent destination type
2283	!! @note
2284	!! If no error occured, the function always set a value which is the default value
2285	!! if the argument has not been parsed. Otherwise, `output` value is undefined.
2286	OBJECT(argparser), INTENT(in) :: this
2287	!! An argparser object reference
2288	CHARACTER(len=*), INTENT(in) :: name
2289	!! Name of the argument
2290	LOGICAL, INTENT(out) :: output
2291	!! A scalar with the first value of the argument
2292	TYPE(error) :: ret
2293	!! Error object with the first error encountered in the process
2294	INTEGER :: idx
2295	ret = ap_check_state(this)
2296	IF (ret == 0) THEN
2297	idx = ap_get_arg_index(this,name)
2298	IF (idx == -1) THEN
2299	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2300	ELSE
2301	ret = argc_get_value(this%args(idx),output)
2302	ENDIF
2303	ENDIF
2304	RETURN
2305	END FUNCTION ap_get_lv_sc
2306
2307	FUNCTION ap_get_cv_sc(this, name, output) RESULT(ret)
2308	!! Get a scalar `COMPLEX` value from given argument
2309	!! The error returned by the method can be either:
2310	!! - 0 : No error
2311	!! - -1 : parser has not been initialized
2312	!! - -7 : argument not found (i.e. does not set in the parser)
2313	!! - -19 : parsing not done yet
2314	!! - -20 : parsing failed
2315	!! - -21 : inconsistent destination type
2316	!! @note
2317	!! If no error occured, the function always set a value which is the default value
2318	!! if the argument has not been parsed. Otherwise, `output` value is undefined.
2319	OBJECT(argparser), INTENT(in) :: this
2320	!! An argparser object reference
2321	CHARACTER(len=*), INTENT(in) :: name
2322	!! Name of the argument
2323	COMPLEX, INTENT(out) :: output
2324	!! A scalar with the first value of the argument
2325	TYPE(error) :: ret
2326	!! Error object with the first error encountered in the process
2327	INTEGER :: idx
2328	ret = ap_check_state(this)
2329	IF (ret == 0) THEN
2330	idx = ap_get_arg_index(this,name)
2331	IF (idx == -1) THEN
2332	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2333	ELSE
2334	ret = argc_get_value(this%args(idx),output)
2335	ENDIF
2336	ENDIF
2337	RETURN
2338	END FUNCTION ap_get_cv_sc
2339
2340	FUNCTION ap_get_sv_sc(this, name, output) RESULT(ret)
2341	!! Get a scalar `STRING` value from given argument
2342	!! The error returned by the method can be either:
2343	!! - 0 : No error
2344	!! - -1 : parser has not been initialized
2345	!! - -7 : argument not found (i.e. does not set in the parser)
2346	!! - -19 : parsing not done yet
2347	!! - -20 : (previous) parsing failed
2348	!! - -21 : inconsistent destination type
2349	!! @note
2350	!! If no error occured, the function always set a value which is the default value
2351	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2352	OBJECT(argparser), INTENT(in) :: this
2353	!! An argparser object reference
2354	CHARACTER(len=*), INTENT(in) :: name
2355	!! Name of the argument
2356	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: output
2357	!! An allocatable string with the first value of the argument
2358	TYPE(error) :: ret
2359	!! Error object with the first error encountered in the process
2360	INTEGER :: idx
2361	ret = ap_check_state(this)
2362	IF (ret == 0) THEN
2363	idx = ap_get_arg_index(this,name)
2364	IF (idx == -1) THEN
2365	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2366	ELSE
2367	ret = argc_get_value(this%args(idx),output)
2368	ENDIF
2369	ENDIF
2370	RETURN
2371	END FUNCTION ap_get_sv_sc
2372
2373	FUNCTION ap_get_dv_ve(this, name, output) RESULT(ret)
2374	!! Get a vector of `REAL(kind=8)` values from given argument
2375	!! The error returned by the method can be either:
2376	!! - 0 : No error
2377	!! - -1 : parser has not been initialized
2378	!! - -7 : argument not found (i.e. does not set in the parser)
2379	!! - -19 : parsing not done yet
2380	!! - -20 : (previous) parsing failed
2381	!! - -21 : inconsistent destination type
2382	!! @note
2383	!! If no error occured, the function always set a value which is the default value
2384	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2385	OBJECT(argparser), INTENT(in) :: this
2386	!! An argparser object reference
2387	CHARACTER(len=*), INTENT(in) :: name
2388	!! Name of the argument
2389	REAL(kind=8), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2390	!! An allocatable vector with the values of the argument
2391	TYPE(error) :: ret
2392	!! Error object with the first error encountered in the process
2393	INTEGER :: idx
2394	ret = ap_check_state(this)
2395	IF (ret == 0) THEN
2396	idx = ap_get_arg_index(this,name)
2397	IF (idx == -1) THEN
2398	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2399	ELSE
2400	ret = argc_get_value(this%args(idx),output)
2401	ENDIF
2402	ENDIF
2403	END FUNCTION ap_get_dv_ve
2404
2405	FUNCTION ap_get_rv_ve(this, name, output) RESULT(ret)
2406	!! Get a vector of `REAL(kind=4)` values from given argument
2407	!! The error returned by the method can be either:
2408	!! - 0 : No error
2409	!! - -1 : parser has not been initialized
2410	!! - -7 : argument not found (i.e. does not set in the parser)
2411	!! - -19 : parsing not done yet
2412	!! - -20 : (previous) parsing failed
2413	!! - -21 : inconsistent destination type
2414	!! @note
2415	!! If no error occured, the function always set a value which is the default value
2416	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2417	OBJECT(argparser), INTENT(in) :: this
2418	!! An argparser object reference
2419	CHARACTER(len=*), INTENT(in) :: name
2420	!! Name of the argument
2421	REAL(kind=4), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2422	!! An allocatable vector with the values of the argument
2423	TYPE(error) :: ret
2424	!! Error object with the first error encountered in the process
2425	INTEGER :: idx
2426	ret = ap_check_state(this)
2427	IF (ret == 0) THEN
2428	idx = ap_get_arg_index(this,name)
2429	IF (idx == -1) THEN
2430	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2431	ELSE
2432	ret = argc_get_value(this%args(idx),output)
2433	ENDIF
2434	ENDIF
2435	END FUNCTION ap_get_rv_ve
2436
2437	FUNCTION ap_get_iv_ve(this, name, output) RESULT(ret)
2438	!! Get a vector of `INTEGER` values from given argument
2439	!! The error returned by the method can be either:
2440	!! - 0 : No error
2441	!! - -1 : parser has not been initialized
2442	!! - -7 : argument not found (i.e. does not set in the parser)
2443	!! - -19 : parsing not done yet
2444	!! - -20 : (previous) parsing failed
2445	!! - -21 : inconsistent destination type
2446	!! @note
2447	!! If no error occured, the function always set a value which is the default value
2448	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2449	OBJECT(argparser), INTENT(in) :: this
2450	!! An argparser object reference
2451	CHARACTER(len=*), INTENT(in) :: name
2452	!! Name of the argument
2453	INTEGER, INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2454	!! An allocatable vector with the values of the argument
2455	TYPE(error) :: ret
2456	!! Error object with the first error encountered in the process
2457	INTEGER :: idx
2458	ret = ap_check_state(this)
2459	IF (ret == 0) THEN
2460	idx = ap_get_arg_index(this,name)
2461	IF (idx == -1) THEN
2462	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2463	ELSE
2464	ret = argc_get_value(this%args(idx),output)
2465	ENDIF
2466	ENDIF
2467	END FUNCTION ap_get_iv_ve
2468
2469	FUNCTION ap_get_lv_ve(this, name, output) RESULT(ret)
2470	!! Get a vector of `LOGICAL` values from given argument
2471	!! The error returned by the method can be either:
2472	!! - 0 : No error
2473	!! - -1 : parser has not been initialized
2474	!! - -7 : argument not found (i.e. does not set in the parser)
2475	!! - -19 : parsing not done yet
2476	!! - -20 : (previous) parsing failed
2477	!! - -21 : inconsistent destination type
2478	!! @note
2479	!! If no error occured, the function always set a value which is the default value
2480	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2481	OBJECT(argparser), INTENT(in) :: this
2482	!! An argparser object reference
2483	CHARACTER(len=*), INTENT(in) :: name
2484	!! Name of the argument
2485	LOGICAL, INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2486	!! An allocatable vector with the values of the argument
2487	TYPE(error) :: ret
2488	!! Error object with the first error encountered in the process
2489	INTEGER :: idx
2490	ret = ap_check_state(this)
2491	IF (ret == 0) THEN
2492	idx = ap_get_arg_index(this,name)
2493	IF (idx == -1) THEN
2494	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2495	ELSE
2496	ret = argc_get_value(this%args(idx),output)
2497	ENDIF
2498	ENDIF
2499	END FUNCTION ap_get_lv_ve
2500
2501	FUNCTION ap_get_cv_ve(this, name, output) RESULT(ret)
2502	!! Get a vector of `COMPLEX` values from given argument
2503	!! The error returned by the method can be either:
2504	!! - 0 : No error
2505	!! - -1 : parser has not been initialized
2506	!! - -7 : argument not found (i.e. does not set in the parser)
2507	!! - -19 : parsing not done yet
2508	!! - -20 : (previous) parsing failed
2509	!! - -21 : inconsistent destination type
2510	!! @note
2511	!! If no error occured, the function always set a value which is the default value
2512	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2513	OBJECT(argparser), INTENT(in) :: this
2514	!! An argparser object reference
2515	CHARACTER(len=*), INTENT(in) :: name
2516	!! Name of the argument
2517	COMPLEX, INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2518	!! An allocatable vector with the values of the argument
2519	TYPE(error) :: ret
2520	!! Error object with the first error encountered in the process
2521	INTEGER :: idx
2522	ret = ap_check_state(this)
2523	IF (ret == 0) THEN
2524	idx = ap_get_arg_index(this,name)
2525	IF (idx == -1) THEN
2526	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2527	ELSE
2528	ret = argc_get_value(this%args(idx),output)
2529	ENDIF
2530	ENDIF
2531	END FUNCTION ap_get_cv_ve
2532
2533	FUNCTION ap_get_sv_ve(this, name, output) RESULT(ret)
2534	!! Get a vector of `STRING` values from given argument
2535	!! The error returned by the method can be either:
2536	!! - 0 : No error
2537	!! - -1 : parser has not been initialized
2538	!! - -7 : argument not found (i.e. does not set in the parser)
2539	!! - -19 : parsing not done yet
2540	!! - -20 : (previous) parsing failed
2541	!! - -21 : inconsistent destination type
2542	!! @note
2543	!! If no error occured, the function always set a value which is the default value
2544	!! if the argument has not been parsed. Otherwise, `output` status is undefined.
2545	OBJECT(argparser), INTENT(in) :: this
2546	!! An argparser object reference
2547	CHARACTER(len=*), INTENT(in) :: name
2548	!! Name of the argument
2549	CHARACTER(len=*), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2550	!! An allocatable vector of assumed length strings with the values of the argument
2551	TYPE(error) :: ret
2552	!! Error object with the first error encountered in the process
2553	INTEGER :: idx
2554	ret = ap_check_state(this)
2555	IF (ret == 0) THEN
2556	idx = ap_get_arg_index(this,name)
2557	IF (idx == -1) THEN
2558	ret = error("argparse: Argument not found ("//TRIM(name)//")",-7)
2559	ELSE
2560	ret = argc_get_value(this%args(idx),output)
2561	ENDIF
2562	ENDIF
2563	END FUNCTION ap_get_sv_ve
2564
2565	! argc getters
2566	! ------------
2567
2568	!> Gets a scalar @p REAL(kind=8) value from given argument
2569	!! @param[in,out] this An argc object
2570	!! @param[out] output A scalar with the first value of the argument
2571	!! @return An errors::error object with -21 if the destination variable's type
2572	!! is inconsistent, 0 otherwise.
2573	FUNCTION ac_get_dv_sc(this, output) RESULT(ret)
2574	!! Get a scalar `REAL(kind=8)` value from given argument
2575	!! If no error occured, the function always returns at least a value (whatever the parser's
2576	!! state is) which is the default value if no specific values are set in the argument.
2577	!! Otherwise, `output` value is undefined.
2578	TYPE(argc), INTENT(in) :: this
2579	!! An argc object
2580	REAL(kind=8), INTENT(out) :: output
2581	!! Output value
2582	TYPE(error) :: ret
2583	!! Error object with the -21 if the destination variable's type is inconsistent, 0 otherwise
2584	ret = noerror
2585	IF (this%ptype /= ap_real) THEN
2586	ret = error("argparse: invalid type for output (expected `"// &
2587	apt2str(this%ptype)//"' got REAL(kind=8))",-21)
2588	ELSEIF (words_length(this%values) == 0) THEN
2589	IF (.NOT.from_string(this%default,output)) &
2590	ret = error("Cannot cast value",-10)
2591	ELSE
2592	IF (.NOT.from_string(words_get(this%values,1), output)) &
2593	ret = error("Cannot cast value",-10)
2594	ENDIF
2595	RETURN
2596	END FUNCTION ac_get_dv_sc
2597
2598	FUNCTION ac_get_rv_sc(this, output) RESULT(ret)
2599	!! Get a scalar `REAL(kind=4)` value from given argument
2600	!! If no error occured, the function always returns at least a value (whatever the parser's
2601	!! state is) which is the default value if no specific values are set in the argument.
2602	!! Otherwise, `output` value is undefined.
2603	TYPE(argc), INTENT(in) :: this
2604	!! An argc object
2605	REAL(kind=4), INTENT(out) :: output
2606	!! Output value
2607	TYPE(error) :: ret
2608	!! Error object with the first error encountered in the process
2609	ret = noerror
2610	IF (this%ptype /= ap_real) THEN
2611	ret = error("argparse: invalid type for output (expected `"// &
2612	apt2str(this%ptype)//"' got REAL(kind=4))",-21)
2613	ELSEIF (words_length(this%values) == 0) THEN
2614	IF (.NOT.from_string(this%default,output)) &
2615	ret = error("Cannot cast value",-10)
2616	ELSE
2617	IF (.NOT.from_string(words_get(this%values,1), output)) &
2618	ret = error("Cannot cast value",-10)
2619	ENDIF
2620	RETURN
2621	END FUNCTION ac_get_rv_sc
2622
2623	FUNCTION ac_get_iv_sc(this, output) RESULT(ret)
2624	!! Get a scalar `INTEGER` value from given argument
2625	!! If no error occured, the function always returns at least a value (whatever the parser's
2626	!! state is) which is the default value if no specific values are set in the argument.
2627	!! Otherwise, `output` value is undefined.
2628	TYPE(argc), INTENT(in) :: this
2629	!! An argc object
2630	INTEGER, INTENT(out) :: output
2631	!! Output value
2632	TYPE(error) :: ret
2633	!! Error object with the first error encountered in the process
2634	ret = noerror
2635	IF (this%ptype /= ap_integer) THEN
2636	ret = error("argparse: invalid type for output (expected `"// &
2637	apt2str(this%ptype)//"' got INTEGER)",-21)
2638	ELSEIF (words_length(this%values) == 0) THEN
2639	IF (.NOT.from_string(this%default,output)) &
2640	ret = error("Cannot cast value",-10)
2641	ELSE
2642	IF (.NOT.from_string(words_get(this%values,1), output)) &
2643	ret = error("Cannot cast value",-10)
2644	ENDIF
2645	RETURN
2646	END FUNCTION ac_get_iv_sc
2647
2648	FUNCTION ac_get_lv_sc(this, output) RESULT(ret)
2649	!! Get a scalar `INTEGER` value from given argument
2650	!! If no error occured, the function always returns at least a value (whatever the parser's
2651	!! state is) which is the default value if no specific values are set in the argument.
2652	!! Otherwise, `output` value is undefined.
2653	TYPE(argc), INTENT(in) :: this
2654	!! An argc object
2655	LOGICAL, INTENT(out) :: output
2656	!! Output value
2657	TYPE(error) :: ret
2658	!! Error object with the first error encountered in the process
2659	ret = noerror
2660	IF (this%ptype /= ap_logical) THEN
2661	ret = error("argparse: invalid type for output (expected `"// &
2662	apt2str(this%ptype)//"' got LOGICAL)",-21)
2663	ELSEIF (words_length(this%values) == 0) THEN
2664	IF (.NOT.from_string(this%default,output)) &
2665	ret = error("Cannot cast value",-10)
2666	ELSE
2667	IF (.NOT.from_string(words_get(this%values,1), output)) &
2668	ret = error("Cannot cast value",-10)
2669	ENDIF
2670	RETURN
2671	END FUNCTION ac_get_lv_sc
2672
2673	FUNCTION ac_get_cv_sc(this, output) RESULT(ret)
2674	!! Get a scalar `COMPLEX` value from given argument
2675	!! If no error occured, the function always returns at least a value (whatever the parser's
2676	!! state is) which is the default value if no specific values are set in the argument.
2677	!! Otherwise, `output` value is undefined.
2678	TYPE(argc), INTENT(in) :: this
2679	!! An argc object
2680	COMPLEX, INTENT(out) :: output
2681	!! Ouput value
2682	TYPE(error) :: ret
2683	!! Error object with the first error encountered in the process
2684	ret = noerror
2685	IF (this%ptype /= ap_complex) THEN
2686	ret = error("argparse: invalid type for output (expected `"// &
2687	apt2str(this%ptype)//"' got COMPLEX)",-21)
2688	ELSEIF (words_length(this%values) == 0) THEN
2689	IF (.NOT.from_string(this%default,output)) &
2690	ret = error("Cannot cast value",-10)
2691	ELSE
2692	IF (.NOT.from_string(words_get(this%values,1), output)) &
2693	ret = error("Cannot cast value",-10)
2694	ENDIF
2695	RETURN
2696	END FUNCTION ac_get_cv_sc
2697
2698	FUNCTION ac_get_sv_sc(this, output) RESULT(ret)
2699	!! Get a scalar `STRING` value from given argument
2700	!! If no error occured, the function always returns at least a value (whatever the parser's
2701	!! state is) which is the default value if no specific values are set in the argument.
2702	!! Otherwise, `output` status is undefined.
2703	TYPE(argc), INTENT(in) :: this
2704	!! An argc object
2705	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: output
2706	!! Output value
2707	TYPE(error) :: ret
2708	!! Error object with the first error encountered in the process
2709	ret = noerror
2710	IF (this%ptype /= ap_string) THEN
2711	ret = error("argparse: invalid type for output (expected `"// &
2712	apt2str(this%ptype)//"' got STRING)",-21)
2713	ELSEIF (words_length(this%values) == 0) THEN
2714	output = this%default
2715	ELSE
2716	output = words_get(this%values,1)
2717	ENDIF
2718	END FUNCTION ac_get_sv_sc
2719
2720	FUNCTION ac_get_dv_ve(this, output) RESULT(ret)
2721	!! Get a vector of `REAL(kind=8)` values from given argument
2722	!! If no error occured, the function always returns at least a value (whatever the parser's
2723	!! state is) which is the default value if no specific values are set in the argument.
2724	!! Otherwise, `output` status is undefined.
2725	TYPE(argc), INTENT(in) :: this
2726	!! Argc object
2727	REAL(kind=8), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2728	!! Output values
2729	TYPE(error) :: ret
2730	!! Error object with the first error encountered in the process
2731	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: tmp
2732	LOGICAL :: ok
2733	ret = noerror
2734	IF (this%ptype /= ap_real) THEN
2735	ret = error("argparse: invalid type for output (expected `"// &
2736	apt2str(this%ptype)//"' got REAL(kind=8))",-21)
2737	ELSEIF (words_length(this%values) == 0) THEN
2738	ALLOCATE(output(MAX(this%nrec,1)))
2739	ok = from_string(this%default,output(1))
2740	output(1:SIZE(output)) = output(1)
2741	ELSE
2742	IF (ALLOCATED(output)) DEALLOCATE(output)
2743	ALLOCATE(output(words_length(this%values)))
2744	ok = words_to_vector(this%values,tmp)
2745	ok = from_string(tmp, output)
2746	ENDIF
2747	END FUNCTION ac_get_dv_ve
2748
2749	FUNCTION ac_get_rv_ve(this, output) RESULT(ret)
2750	!! Get a vector of `REAL(kind=4)` values from given argument
2751	!! If no error occured, the function always returns at least a value (whatever the parser's
2752	!! state is) which is the default value if no specific values are set in the argument.
2753	!! Otherwise, `output` status is undefined.
2754	TYPE(argc), INTENT(in) :: this
2755	!! Argc object
2756	REAL(kind=4), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2757	!! Output values
2758	TYPE(error) :: ret
2759	!! Error object with the first error encountered in the process
2760	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: tmp
2761	LOGICAL :: ok
2762	ret = noerror
2763	IF (this%ptype /= ap_real) THEN
2764	ret = error("argparse: invalid type for output (expected `"// &
2765	apt2str(this%ptype)//"' got REAL(kind=4))",-21)
2766	ELSEIF (words_length(this%values) == 0) THEN
2767	ALLOCATE(output(MAX(this%nrec,1)))
2768	ok = from_string(this%default,output(1))
2769	output(1:SIZE(output)) = output(1)
2770	ELSE
2771	IF (ALLOCATED(output)) DEALLOCATE(output)
2772	ALLOCATE(output(words_length(this%values)))
2773	ok = words_to_vector(this%values,tmp)
2774	ok = from_string(tmp, output)
2775	ENDIF
2776	END FUNCTION ac_get_rv_ve
2777
2778	FUNCTION ac_get_iv_ve(this, output) RESULT(ret)
2779	!! Get a vector of `INTEGER` values from given argument
2780	!! If no error occured, the function always returns at least a value (whatever the parser's
2781	!! state is) which is the default value if no specific values are set in the argument.
2782	!! Otherwise, `output` status is undefined.
2783	TYPE(argc), INTENT(in) :: this
2784	!! Argc object
2785	INTEGER, INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2786	!! Output values
2787	TYPE(error) :: ret
2788	!! Error object with the first error encountered in the process
2789	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: tmp
2790	LOGICAL :: ok
2791	ret = noerror
2792	IF (this%ptype /= ap_integer) THEN
2793	ret = error("argparse: invalid type for output (expected `"// &
2794	apt2str(this%ptype)//"' got INTEGER)",-21)
2795	ELSEIF (words_length(this%values) == 0) THEN
2796	ALLOCATE(output(MAX(this%nrec,1)))
2797	ok = from_string(this%default,output(1))
2798	output(1:SIZE(output)) = output(1)
2799	ELSE
2800	IF (ALLOCATED(output)) DEALLOCATE(output)
2801	ALLOCATE(output(words_length(this%values)))
2802	ok = words_to_vector(this%values,tmp)
2803	ok = from_string(tmp, output)
2804	ENDIF
2805	END FUNCTION ac_get_iv_ve
2806
2807	FUNCTION ac_get_lv_ve(this, output) RESULT(ret)
2808	!! Get a vector of `LOGICAL` values from given argument
2809	!! If no error occured, the function always returns at least a value (whatever the parser's
2810	!! state is) which is the default value if no specific values are set in the argument.
2811	!! Otherwise, `output` status is undefined.
2812	TYPE(argc), INTENT(in) :: this
2813	!! Argc object
2814	LOGICAL, INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2815	!! Output values
2816	TYPE(error) :: ret
2817	!! Error object with the first error encountered in the process
2818	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: tmp
2819	LOGICAL :: ok
2820	ret = noerror
2821	IF (this%ptype /= ap_logical) THEN
2822	ret = error("argparse: invalid type for output (expected `"// &
2823	apt2str(this%ptype)//"' got LOGICAL)",-21)
2824	ELSEIF (words_length(this%values) == 0) THEN
2825	ALLOCATE(output(MAX(this%nrec,1)))
2826	ok = from_string(this%default,output(1))
2827	output(1:SIZE(output)) = output(1)
2828	ELSE
2829	IF (ALLOCATED(output)) DEALLOCATE(output)
2830	ALLOCATE(output(words_length(this%values)))
2831	ok = words_to_vector(this%values,tmp)
2832	ok = from_string(tmp, output)
2833	ENDIF
2834	END FUNCTION ac_get_lv_ve
2835
2836	FUNCTION ac_get_cv_ve(this, output) RESULT(ret)
2837	!! Get a vector of `COMPLEX` values from given argument
2838	!! If no error occured, the function always returns at least a value (whatever the parser's
2839	!! state is) which is the default value if no specific values are set in the argument.
2840	!! Otherwise, `output` status is undefined.
2841	TYPE(argc), INTENT(in) :: this
2842	!! Argc object
2843	COMPLEX, INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2844	!! Output values
2845	TYPE(error) :: ret
2846	!! Error object with the first error encountered in the process
2847	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: tmp
2848	LOGICAL :: ok
2849	ret = noerror
2850	IF (this%ptype /= ap_complex) THEN
2851	ret = error("argparse: invalid type for output (expected `"// &
2852	apt2str(this%ptype)//"' got COMPLEX)",-21)
2853	ELSEIF (words_length(this%values) == 0) THEN
2854	ALLOCATE(output(MAX(this%nrec,1)))
2855	ok = from_string(this%default,output(1))
2856	output(1:SIZE(output)) = output(1)
2857	ELSE
2858	IF (ALLOCATED(output)) DEALLOCATE(output)
2859	ALLOCATE(output(words_length(this%values)))
2860	ok = words_to_vector(this%values,tmp)
2861	ok = from_string(tmp, output)
2862	ENDIF
2863	END FUNCTION ac_get_cv_ve
2864
2865	FUNCTION ac_get_sv_ve(this, output) RESULT(ret)
2866	!! Get a vector of `STRING` values from given argument
2867	!! If no error occured, the function always returns at least a value (whatever the parser's
2868	!! state is) which is the default value if no specific values are set in the argument.
2869	!! Otherwise, `output` status is undefined.
2870	TYPE(argc), INTENT(in) :: this
2871	!! Argc object
2872	CHARACTER(len=st_slen), INTENT(out), ALLOCATABLE, DIMENSION(:) :: output
2873	!! Output values
2874	TYPE(error) :: ret
2875	!! Error object with the first error encountered in the process
2876	ret = noerror
2877	IF (this%ptype /= ap_string) THEN
2878	ret = error("argparse: invalid type for output (expected `"// &
2879	apt2str(this%ptype)//"' got STRING)",-21)
2880	ELSEIF (words_length(this%values) == 0) THEN
2881	ALLOCATE(output(MAX(this%nrec,1)))
2882	output(1:SIZE(output)) = TRIM(this%default)
2883	ELSE
2884	IF (.NOT.words_to_vector(this%values,output)) DEALLOCATE(output)
2885	ENDIF
2886	END FUNCTION ac_get_sv_ve
2887
2888	! miscellaneous methods
2889	! ---------------------
2890
2891	FUNCTION apt2str(ap_t) RESULT(str)
2892	!! Get the string representation of argparse types constants
2893	INTEGER, INTENT(in) :: ap_t
2894	!! One of ap_logical, ap_integer, ap_real, ap_complex or ap_string module constants.
2895	CHARACTER(len=:), ALLOCATABLE :: str
2896	!! String representation of the type.
2897	SELECT CASE(ap_t)
2898	CASE(ap_logical) ; str = 'logical'
2899	CASE(ap_integer) ; str = 'integer'
2900	CASE(ap_real) ; str = 'real'
2901	CASE(ap_complex) ; str = 'complex'
2902	CASE(ap_string) ; str = 'string'
2903	CASE DEFAULT ; str = 'unknown'
2904	END SELECT
2905	RETURN
2906	END FUNCTION apt2str
2907
2908	FUNCTION apa2str(ap_a) RESULT(str)
2909	!! Get the string representation of argparse actions constants
2910	INTEGER, INTENT(in) :: ap_a
2911	!! One of ap_store, ap_append,cap_count or ap_help module constants
2912	CHARACTER(len=:), ALLOCATABLE :: str
2913	!! String representation of the action.
2914	SELECT CASE(ap_a)
2915	CASE(ap_store) ; str = 'store'
2916	CASE(ap_append) ; str = 'append'
2917	CASE(ap_count) ; str = 'count'
2918	CASE(ap_help) ; str = 'help'
2919	CASE(ap_version); str = 'version'
2920	CASE DEFAULT ; str = 'unknown'
2921	END SELECT
2922	RETURN
2923	END FUNCTION apa2str
2924
2925	FUNCTION get_progname() RESULT(name)
2926	!> Get the name of the program
2927	CHARACTER(len=:), ALLOCATABLE :: name !! The name of the program
2928	INTEGER :: c
2929	CALL GET_COMMAND_ARGUMENT(0,length=c)
2930	ALLOCATE(CHARACTER(len=c) :: name)
2931	CALL GET_COMMAND_ARGUMENT(0,value=name)
2932	c = INDEX(name, "/", back=.true.)
2933	IF (c /= 0.AND.c /= LEN_TRIM(name)) name = TRIM(name(c+1:))
2934	END FUNCTION get_progname
2935
2936	END MODULE ARGPARSE
2937

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format