Context Navigation

argparse.F90 @ 1819

Last change on this file since 1819 was 1814, checked in by jvatant, 7 years ago
Correct string management within muphy for ifort JVO
File size: 114.1 KB

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

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

Download in other formats:

Original Format