Line data Source code
1 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
3 : !!!! !!!!
4 : !!!! ParaMonte: Parallel Monte Carlo and Machine Learning Library. !!!!
5 : !!!! !!!!
6 : !!!! Copyright (C) 2012-present, The Computational Data Science Lab !!!!
7 : !!!! !!!!
8 : !!!! This file is part of the ParaMonte library. !!!!
9 : !!!! !!!!
10 : !!!! LICENSE !!!!
11 : !!!! !!!!
12 : !!!! https://github.com/cdslaborg/paramonte/blob/main/LICENSE.md !!!!
13 : !!!! !!!!
14 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
16 :
17 : !> \brief
18 : !> This file contains procedure implementations of [pm_sysShell](@ref pm_sysShell).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \FatemehBagheri, Wednesday 12:20 AM, October 13, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : submodule (pm_sysShell) routines ! LCOV_EXCL_LINE
28 :
29 : #if CHECK_ENABLED
30 : use pm_err, only: getFine
31 : use pm_val2str, only: getStr
32 : use pm_err, only: setAsserted
33 : #define CHECK_ASSERTION(LINE,ASSERTION,MSG) \
34 : call setAsserted(ASSERTION,getFine(__FILE__,LINE)//MODULE_NAME//MSG);
35 : #else
36 : #define CHECK_ASSERTION(LINE,ASSERTION,MSG) continue;
37 : #endif
38 :
39 : use pm_strASCII, only: getStrLower
40 : use pm_io, only: setContentsFrom
41 : use pm_io, only: LEN_IOMSG
42 :
43 : implicit none
44 :
45 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
46 :
47 : !> \brief
48 : !> The scalar `private` module object of type [shell_type](@ref pm_sysShell::shell_type).
49 : !>
50 : !> \details
51 : !> This object is set only once throughout the life of the program to avoid costly redundant construction of shell objects.<br>
52 : !> It is set by and exclusively used within the routines of this submodule and nowhere else.<br>
53 : !> The allocation status of the object is used as an indicator of its initialization.<br>
54 : !>
55 : !> \finmain{mc_shell}
56 : !>
57 : !> \author
58 : !> \AmirShahmoradi, Tuesday March 7, 2017, 3:50 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
59 : type, extends(shell_type) :: shellinit_type
60 : logical(LK) :: initialized = .false._LK
61 : end type
62 : type(shellinit_type) :: mc_shell
63 :
64 : !> \brief
65 : !> The scalar `private` module object of type `logical` of default kind \LK.
66 : !>
67 : !> \details
68 : !> This scalar runtime constant is used to indicate whether the scalar runtime constant [mc_shell](@ref pm_sysShell::mc_shell) is set.<br>
69 : !> This indicator could have readily been the allocation status of an `allocatable` mc_shell.<br>
70 : !> However, gfortran as of V. 13 appears to have bug not being able to set the components of the object correctly.<br>
71 : !>
72 : !> \finmain{mc_shellSet}
73 : !>
74 : !> \author
75 : !> \AmirShahmoradi, Tuesday March 7, 2017, 3:50 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
76 : !logical(LK) :: mc_shellSet = .false._LK
77 :
78 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
79 :
80 : !> \brief
81 : !> The `allocatable` scalar of type `character` of default kind \SK containing the path to the system temporary directory.<br>
82 : !> This runtime module constant is meant to be allocated and set once at runtime and used later throughout the program.<br>
83 : character(:, SK), save, allocatable :: mc_sysDirTemp
84 :
85 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
86 :
87 : contains
88 :
89 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
90 :
91 : !function isFailedInitShell(errmsg) result(failed)
92 : ! use pm_kind, only: SKC => SK
93 : ! character(*,SKC), intent(inout), optional :: errmsg
94 : ! logical(LK) :: failed
95 : ! failed = .not. allocated(mc_shell)
96 : ! if (failed) then
97 : ! if (present(errmsg)) then
98 : ! allocate(mc_shell, source = shell_type(failed, errmsg))
99 : ! else
100 : ! allocate(mc_shell, source = shell_type(failed))
101 : ! end if
102 : ! !mc_shellSet = .not. failed
103 : ! if (failed .and. allocated(mc_shell)) deallocate(mc_shell)
104 : ! end if
105 : !end function
106 :
107 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
108 :
109 45 : module procedure isFailedGetDirTemp
110 : character(LEN_IOMSG, SK) :: errmsg
111 45 : errmsg = SK_""
112 45 : failed = isFailedGetDirTemp(dirTemp, errmsg)
113 45 : end procedure
114 :
115 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
116 :
117 387620 : module procedure isFailedGetDirTempMsg
118 : use pm_kind, only: SKC => SK
119 : use pm_sysPath, only: isDir
120 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@isFailedGetDirTemp()"
121 : integer(IK), parameter :: MAXLEN = max(len(VARENV_DIRTEMP_UNIX), len(VARENV_DIRTEMP_WINDOWS))
122 : character(MAXLEN, SK), parameter :: VARENV_DIRTEMP(*) = [character(MAXLEN,SKC) :: VARENV_DIRTEMP_UNIX, VARENV_DIRTEMP_WINDOWS]
123 : integer(IK) :: ienv
124 : #if OMP_ENABLED
125 : !$omp critical
126 : #endif
127 387212 : if (allocated(mc_sysDirTemp)) then
128 387076 : dirTemp = mc_sysDirTemp
129 : failed = .false._LK
130 : else
131 : ! We cannot infer the runtime shell through `isShellWindows` or similar functions as they create unlimited circular recursive calls.
132 : ! Instead, we check all environmental variables for all shells, from posix to windows.
133 952 : do ienv = 1_IK, size(VARENV_DIRTEMP, 1, IK)
134 816 : failed = isFailedGetEnvVar(trim(VARENV_DIRTEMP(ienv)), dirTemp, errmsg) ! returns empty upon error
135 816 : failed = failed .or. logical(len_trim(dirTemp, IK) == 0_IK, LK)
136 136 : if (.not. failed) exit
137 : end do
138 : ! One last try.
139 136 : if (failed) dirTemp = SKC_"/tmp"
140 136 : failed = .not. isDir(dirTemp, ienv, errmsg)
141 136 : failed = failed .or. ienv /= 0_IK
142 136 : if (.not. failed) mc_sysDirTemp = dirTemp
143 : end if
144 : #if OMP_ENABLED
145 : !$omp end critical
146 : #endif
147 387212 : end procedure
148 : !#if INTEL_ENABLED
149 : !#define FILE_ARG directory = SKC_"/tmp/"
150 : !#else
151 : !#define FILE_ARG file = SKC_"/tmp/"
152 : !#endif
153 : ! inquire(FILE_ARG, exist = exists, iostat = i, iomsg = errmsg) ! last forward slash in FILE_ARG is significant.
154 : !#undef FILE_ARG
155 : ! failed = logical(i /= 0_IK, LK) .or. .not. exists
156 : ! if (failed) then
157 : ! errmsg = PROCEDURE_NAME//SK_": Failed to fetch shell temporary dir. "//trim(errmsg) ! LCOV_EXCL_LINE
158 : ! return ! LCOV_EXCL_LINE
159 : ! end if
160 :
161 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
162 :
163 192810 : module procedure isFailedGetOutput
164 : character(LEN_IOMSG, SK) :: errmsg
165 192810 : errmsg = SK_""
166 192810 : failed = isFailedGetOutput(command, output, errmsg)
167 192810 : end procedure
168 :
169 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
170 :
171 579838 : module procedure isFailedGetOutputMsg
172 : use pm_err, only: getLine
173 : use pm_kind, only: SKC => SK
174 : use pm_str, only: isEndedWith
175 : use pm_arrayStrip, only: getStripped
176 : use pm_parallelism, only: getImageID
177 : use pm_distUnif, only: setUnifRand, xoshiro256ssw_type
178 : type(xoshiro256ssw_type) :: rng
179 : character(*, SK), parameter :: NLC = new_line(SKC_"a"), LF = char(10, SKC), CR = char(13, SKC)
180 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@isFailedGetOutputMsg()"
181 193280 : character(:,SKC), allocatable :: filetemp, basetemp
182 : integer(IK) , parameter :: lenNLC = len(NLC, IK)
183 : integer(IK) , parameter :: NTRY = 100000_IK
184 : !integer(IK) :: lenBaseTempPlus1
185 : integer(IK) :: lenBaseTemp
186 : integer(IK) :: lenFileTemp
187 : integer(IK) :: counter
188 : !integer(IK) :: length
189 : integer(IK) :: iostat
190 : #define SET_ERRMSG(LINE)\
191 : errmsg = PROCEDURE_NAME//getLine(LINE)//SK_": Failed to fetch command output. "//trim(errmsg)
192 : ! Determine the shell type.
193 :
194 : !type(shell_type) :: shell
195 : !shell = shell_type(failed, errmsg)
196 : !RETURN_IF(failed) ! fpp
197 :
198 : ! Fetch the system temporary dir and create the base of the path.
199 :
200 386560 : failed = isFailedGetDirTemp(basetemp, errmsg)
201 193280 : if (failed) then
202 0 : basetemp = SKC_"isFailedGetOutputMsg.tmp."
203 : else
204 : !basetemp = basetemp//shell%dirsep//SKC_"isFailedGetOutputMsg.tmp"
205 : ! \todo
206 : ! \warning
207 : ! The following assumes that all platforms and runtime shells recognize forward slash as a directory separator.
208 : ! While this is currently the case, it may not be so in the future. A more robust solution may be necessary.
209 : ! One solution is to remove dependence on the temporary directory and create the file in the current directory.
210 193280 : basetemp = basetemp//SKC_"/isFailedGetOutputMsg.tmp."
211 : end if
212 :
213 : ! Generate a unique file to avoid racing conditions in parallel.
214 :
215 193280 : lenBaseTemp = len(basetemp, IK)
216 193280 : lenFileTemp = lenBaseTemp + 20_IK ! 18 + 12_IK ! date_and_time() is 18 characters.
217 : if (allocated(filetemp)) deallocate(filetemp) ! \bug gfortran bug in automatic deallocation as of version 11.
218 193280 : allocate(character(lenFileTemp, SKC) :: filetemp)
219 193280 : rng = xoshiro256ssw_type(imageID = getImageID())
220 193280 : filetemp(1 : lenBaseTemp) = basetemp
221 193280 : do counter = 1_IK, NTRY
222 : !call setStr(filetemp(lenBaseTempPlus1 : lenFileTemp), length, counter)
223 : !inquire(file = filetemp(1 : lenBaseTempPlus1 + length - 1), exist = failed, iostat = iostat, iomsg = errmsg)
224 : !call setUnifRand(filetemp(lenBaseTemp + 19 :), SKC_"a", SKC_"z")
225 : !call date_and_time(date = filetemp(lenBaseTemp + 1 : lenBaseTemp + 8), time = filetemp(lenBaseTemp + 9 : lenBaseTemp + 18))
226 193280 : call setUnifRand(rng, filetemp(lenBaseTemp + 1 :), SKC_"a", SKC_"z")
227 193280 : inquire(file = filetemp, exist = failed, iostat = iostat, iomsg = errmsg)
228 193280 : failed = failed .or. logical(iostat /= 0_IK, LK)
229 193280 : if (.not. failed) exit
230 : end do
231 : !lenFileTemp = lenBaseTempPlus1 + length - 1_IK
232 :
233 193280 : if (.not. failed) then
234 : ! Run the command. Beware that the command execution can fail if the command is nonsensical.
235 193280 : failed = isFailedExec(command//SKC_" 1>"""//filetemp(1 : lenFileTemp)//SKC_""" 2>&1", cmdmsg = errmsg, exitstat = exitstat)
236 193280 : if (.not. failed) then
237 : ! Read the command output from file if it exists.
238 193280 : call setContentsFrom(filetemp(1 : lenFileTemp), contents = output, iostat = iostat, iomsg = errmsg, del = .true._LK)
239 193280 : failed = logical(iostat /= 0_IK, LK)
240 193280 : if (failed) then
241 1 : SET_ERRMSG(__LINE__)
242 : else
243 : ! Remove the end-of-file (linefeed) and Carriage Return characters from the captured text,
244 : ! because this is artificially added to the command output when written to the file.
245 : !if (output(max(1_IK, len(output, IK) - lenNLC + 1_IK) : len(output, IK)) == NLC) output = output(1 : len(output, IK) - lenNLC)
246 : !output = output(getSIL(output, new_line(SKC_"a")) : getSIR(output, new_line(SKC_"a")))
247 193279 : output = getStripped(output, NLC)
248 0 : loopStrip: do
249 193279 : counter = min(1, len(output))
250 193279 : if (output(1 : counter) == LF .or. isEndedWith(output, LF) .or. output(1 : counter) == CR .or. isEndedWith(output, CR)) then
251 0 : output = getStripped(getStripped(output, new_line(SKC_"a")), achar(13, SKC)) ! CR must be removed on Windows OS.
252 : else
253 : exit loopStrip
254 : end if
255 : end do loopStrip
256 : end if
257 : else
258 0 : SET_ERRMSG(__LINE__)
259 : end if
260 : else
261 0 : SET_ERRMSG(__LINE__)
262 : end if
263 : #undef SET_ERRMSG
264 1159680 : end procedure
265 :
266 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
267 :
268 775170 : module procedure isFailedExec
269 : use pm_kind, only: SKC => SK
270 : use pm_val2str, only: getStr
271 : character(:, SK), allocatable :: details
272 : logical :: wait_def
273 : integer :: cmdstat_def
274 : integer :: exitstat_def
275 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@isFailedExec()"
276 : character(*, SK), parameter :: LF = new_line(SK_"a")
277 :
278 775170 : if (present(wait)) then
279 56 : wait_def = logical(wait, LK)
280 : else
281 775114 : wait_def = .true._LK
282 : end if
283 :
284 775170 : if (present(exitstat)) exitstat_def = int(exitstat)
285 :
286 775170 : if (present(cmdmsg)) then
287 193330 : call execute_command_line(command, wait_def, exitstat_def, cmdstat_def, cmdmsg)
288 : else
289 581840 : call execute_command_line(command, wait_def, exitstat_def, cmdstat_def)
290 : end if
291 :
292 775170 : if (present(exitstat)) exitstat = int(exitstat_def, IK)
293 775170 : if (present(cmdstat)) cmdstat = int(cmdstat_def, IK)
294 :
295 775170 : failed = logical(cmdstat_def /= 0, LK)
296 :
297 775170 : if (failed .and. present(cmdmsg)) then
298 : details = LF//SK_"exitstat = "//getStr(exitstat_def)//LF//SK_"cmdstat = "//getStr(cmdstat_def)//LF//SK_"command = "//getStr(command) ! LCOV_EXCL_LINE
299 : if (cmdstat_def == -1) then ! LCOV_EXCL_LINE
300 : cmdmsg = PROCEDURE_NAME//SK_": The processor does not support command execution. command: "//details ! LCOV_EXCL_LINE
301 : elseif (cmdstat_def == -2 .and. wait_def) then ! LCOV_EXCL_LINE
302 : cmdmsg = PROCEDURE_NAME//SK_": processor does not support asynchronous command execution. command: "//details ! LCOV_EXCL_LINE
303 : elseif (cmdstat_def > 0) then ! LCOV_EXCL_LINE
304 : cmdmsg = PROCEDURE_NAME//SK_": "//trim(adjustl(cmdmsg))//details ! LCOV_EXCL_LINE
305 : else ! LCOV_EXCL_LINE
306 : error stop "How on Earth this could happen?! Hey compiler, you are violating the 2018 Fortran standard here." ! LCOV_EXCL_LINE
307 : end if
308 : end if
309 775170 : end procedure
310 :
311 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
312 :
313 9 : module procedure isShellWindows
314 : logical(LK) :: failed
315 : character(LEN_IOMSG, SK) :: errmsg
316 9 : shellIsWindows = isShellWindows(failed, errmsg)
317 : if (failed) error stop MODULE_NAME//SK_"@isShellWindows(): "//trim(errmsg) ! LCOV_EXCL_LINE
318 9 : end procedure
319 :
320 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
321 :
322 1 : module procedure isShellWindowsFailed
323 : character(LEN_IOMSG, SK) :: errmsg
324 1 : shellIsWindows = isShellWindows(failed, errmsg)
325 1 : end procedure
326 :
327 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
328 :
329 11 : module procedure isShellWindowsFailedMsg
330 11 : type(shell_type) :: shell
331 11 : shell = shell_type(failed, errmsg)
332 : !failed = isFailedInitShell(errmsg)
333 11 : if (failed) then
334 : errmsg = MODULE_NAME//SK_"@isShellWindowsFailedMsg(): Failed to fetch shell type. "//trim(errmsg) ! LCOV_EXCL_LINE
335 : shellIsWindows = .false._LK
336 : else
337 11 : shellIsWindows = shell%is%windows
338 : end if
339 22 : end procedure
340 :
341 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
342 :
343 9 : module procedure isShellPosix
344 : logical(LK) :: failed
345 : character(LEN_IOMSG, SK) :: errmsg
346 9 : shellIsPosix = isShellPosix(failed, errmsg)
347 : if (failed) error stop MODULE_NAME//SK_"@isShellPosix(): "//trim(errmsg) ! LCOV_EXCL_LINE
348 9 : end procedure
349 :
350 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
351 :
352 1 : module procedure isShellPosixFailed
353 : character(LEN_IOMSG, SK) :: errmsg
354 1 : shellIsPosix = isShellPosix(failed, errmsg)
355 1 : end procedure
356 :
357 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
358 :
359 11 : module procedure isShellPosixFailedMsg
360 : !failed = .not. mc_shellSet
361 : !if (failed) then
362 : ! if (allocated(mc_shell)) deallocate(mc_shell); mc_shell = shell_type(failed, errmsg)
363 : ! mc_shellSet = .not. failed
364 : !end if
365 11 : type(shell_type) :: shell
366 11 : shell = shell_type(failed, errmsg)
367 : !failed = isFailedInitShell(errmsg)
368 11 : if (failed) then
369 : errmsg = MODULE_NAME//SK_"@isShellPosixFailedMsg(): Failed to fetch shell type. "//trim(errmsg) ! LCOV_EXCL_LINE
370 : shellIsPosix = .false._LK
371 : else
372 11 : shellIsPosix = shell%is%posix
373 : end if
374 22 : end procedure
375 :
376 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
377 :
378 1 : module procedure isShellCMD
379 : logical(LK) :: failed
380 : character(LEN_IOMSG, SK) :: errmsg
381 1 : shellIsCMD = isShellCMD(failed, errmsg)
382 : if (failed) error stop MODULE_NAME//SK_"@isShellCMD(): "//trim(errmsg) ! LCOV_EXCL_LINE
383 1 : end procedure
384 :
385 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
386 :
387 1 : module procedure isShellCMDFailed
388 : character(LEN_IOMSG, SK) :: errmsg
389 1 : shellIsCMD = isShellCMD(failed, errmsg)
390 1 : end procedure
391 :
392 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
393 :
394 3 : module procedure isShellCMDFailedMsg
395 : !failed = .not. mc_shellSet
396 : !if (failed) then
397 : ! if (allocated(mc_shell)) deallocate(mc_shell); mc_shell = shell_type(failed, errmsg)
398 : ! mc_shellSet = .not. failed
399 : !end if
400 : !failed = isFailedInitShell(errmsg)
401 3 : type(shell_type) :: shell
402 3 : shell = shell_type(failed, errmsg)
403 3 : if (failed) then
404 : errmsg = MODULE_NAME//SK_"@isShellCMDFailedMsg(): Failed to fetch shell type. "//trim(errmsg) ! LCOV_EXCL_LINE
405 : shellIsCMD = .false._LK
406 : else
407 3 : shellIsCMD = shell%is%cmd
408 : end if
409 6 : end procedure
410 :
411 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
412 :
413 1 : module procedure isShellPowerShell
414 : logical(LK) :: failed
415 : character(LEN_IOMSG, SK) :: errmsg
416 1 : shellIsPowerShell = isShellPowerShell(failed, errmsg)
417 : if (failed) error stop MODULE_NAME//SK_"@isShellPowerShell(): "//trim(errmsg) ! LCOV_EXCL_LINE
418 1 : end procedure
419 :
420 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
421 :
422 1 : module procedure isShellPowerShellFailed
423 : character(LEN_IOMSG, SK) :: errmsg
424 1 : shellIsPowerShell = isShellPowerShell(failed, errmsg)
425 1 : end procedure
426 :
427 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
428 :
429 3 : module procedure isShellPowerShellFailedMsg
430 : !failed = .not. mc_shellSet
431 : !if (failed) then
432 : ! if (allocated(mc_shell)) deallocate(mc_shell); mc_shell = shell_type(failed, errmsg)
433 : ! mc_shellSet = .not. failed
434 : !end if
435 : !failed = isFailedInitShell(errmsg)
436 3 : type(shell_type) :: shell
437 3 : shell = shell_type(failed, errmsg)
438 3 : if (failed) then
439 : errmsg = MODULE_NAME//SK_"@isShellPowerShellFailedMsg(): Failed to fetch shell type. "//trim(errmsg) ! LCOV_EXCL_LINE
440 : shellIsPowerShell = .false._LK
441 : else
442 3 : shellIsPowerShell = shell%is%powershell
443 : end if
444 6 : end procedure
445 :
446 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
447 :
448 158 : module procedure constructShellIs
449 : character(LEN_IOMSG, SK) :: errmsg
450 : logical(LK) :: failed
451 158 : errmsg = SK_""
452 158 : shellis = shellis_type(failed, errmsg)
453 : if (failed) error stop MODULE_NAME//SK_"@constructShellIs(): "//trim(errmsg) ! LCOV_EXCL_LINE
454 158 : end procedure
455 :
456 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
457 :
458 134 : module procedure constructShellIsFailed
459 : character(LEN_IOMSG, SK) :: errmsg
460 134 : errmsg = SK_""
461 134 : shellis = shellis_type(failed, errmsg)
462 134 : end procedure
463 :
464 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
465 :
466 481 : module procedure constructShellIsFailedMsg
467 : !failed = .not. mc_shellSet
468 : !if (failed) then
469 : ! if (allocated(mc_shell)) deallocate(mc_shell); mc_shell = shell_type(failed, errmsg)
470 : ! mc_shellSet = .not. failed
471 : !end if
472 : !failed = isFailedInitShell(errmsg)
473 481 : type(shell_type) :: shell
474 481 : shell = shell_type(failed, errmsg)
475 481 : if (failed) then
476 : errmsg = MODULE_NAME//SK_"@constructShellIsFailedMsg(): "//trim(errmsg) ! LCOV_EXCL_LINE
477 : else
478 481 : shellis = shell%is
479 : end if
480 962 : end procedure
481 :
482 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
483 :
484 77 : module procedure constructShell
485 : character(LEN_IOMSG, SK) :: errmsg
486 : logical(LK) :: failed
487 77 : errmsg = SK_""
488 77 : shell = shell_type(failed, errmsg)
489 : if (failed) error stop MODULE_NAME//SK_"@constructShell(): "//trim(errmsg) ! LCOV_EXCL_LINE
490 77 : end procedure
491 :
492 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
493 :
494 192832 : module procedure constructShellFailed
495 : character(31, SK) :: errmsg
496 192832 : errmsg = SK_""
497 192832 : shell = shell_type(failed, errmsg)
498 192832 : end procedure
499 :
500 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
501 :
502 193886 : module procedure constructShellFailedMsg
503 :
504 : use pm_parallelism, only: getImageID
505 : use pm_sysPath, only: DIR_SEP_WINDOWS, DIR_SEP_WINDOWS_ALL
506 : use pm_sysPath, only: PATH_SEP_POSIX, PATH_SEP_WINDOWS
507 : use pm_sysPath, only: DIR_SEP_POSIX, DIR_SEP_POSIX_ALL
508 : use pm_distUnif, only: setUnifRand, xoshiro256ssw_type
509 : use pm_arrayStrip, only: getSIL, getSIR
510 : use pm_kind, only: SKC => SK
511 : use pm_err, only: getLine
512 :
513 : type(xoshiro256ssw_type) :: rng
514 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@constructShell()"
515 : character(*, SK), parameter :: LF = new_line(SK_"a")
516 193886 : character(:, SK), allocatable :: filetemp, basetemp
517 : integer(IK) , parameter :: NTRY = 100000_IK
518 : integer(IK) :: iostat, counter
519 : integer(IK) :: lenBaseTemp
520 : integer(IK) :: lenFileTemp
521 : #define SET_ERRMSG(LINE)\
522 : errmsg = PROCEDURE_NAME//getLine(LINE)//SK_": Failed to fetch shell name. "//trim(errmsg)
523 :
524 1163316 : if (mc_shell%initialized) then
525 :
526 0 : shell = mc_shell%shell_type
527 0 : failed = .false._LK
528 :
529 : else
530 :
531 : ! Initialize the allocatable components to the default.
532 :
533 193886 : shell%name = SKC_""
534 193886 : shell%dirseps = DIR_SEP_POSIX_ALL
535 :
536 : ! Fetch the system temporary dir and create the base of the path.
537 :
538 193886 : failed = isFailedGetDirTemp(basetemp, errmsg)
539 193886 : if (failed) then
540 0 : basetemp = SKC_"constructShell.tmp."
541 : else
542 : ! \todo
543 : ! \warning
544 : ! The following assumes that all platforms and runtime shells recognize forward slash as a directory separator.
545 : ! While this is currently the case, it may not be so in the future. A more robust solution may be necessary.
546 : ! One solution is to remove dependence on the temporary directory and create the file in the current directory.
547 193886 : basetemp = basetemp//SKC_"/constructShell.tmp."
548 : end if
549 :
550 : ! Generate a unique file name to avoid racing conditions in parallel.
551 :
552 193886 : lenBaseTemp = len(basetemp, IK)
553 193886 : lenFileTemp = lenBaseTemp + 21 ! + 12 ! + 1 dot + date and time length is 18.
554 : if (allocated(filetemp)) deallocate(filetemp) ! \bug gfortran bug in automatic deallocation as of version 11.
555 193886 : allocate(character(lenFileTemp, SKC) :: filetemp)
556 193886 : rng = xoshiro256ssw_type(imageID = getImageID())
557 193886 : filetemp(1 : lenBaseTemp) = basetemp
558 193886 : do counter = 1_IK, NTRY
559 193886 : call setUnifRand(rng, filetemp(lenBaseTemp + 1 :), SKC_"a", SKC_"z")
560 193886 : inquire(file = filetemp, exist = failed, iostat = iostat, iomsg = errmsg)
561 193886 : failed = failed .or. logical(iostat /= 0_IK, LK)
562 193886 : if (.not. failed) exit
563 : end do
564 :
565 193886 : if (failed) then
566 0 : SET_ERRMSG(__LINE__)
567 : else
568 : ! First check for Unix shells, as the command does not lead to odd syntax errors on a Windows shell.
569 : ! $SHELL gives the full path to the default shell (not the runtime shell).
570 : ! $0 gives the name (OR the path, e.g., in Git Bash) of the current shell.
571 : ! $0 works in the following shells as of 2022: ash, bash, csh, dash, sh, tcsh, zsh, yash
572 : ! $0 does not work in the following shells as of 2022: cmd, fish, powershell, pwsh,
573 : ! WARNING
574 : ! You may think `isFailedExec()` can be replaced with `isFailedGetOutput()` in the following.
575 : ! That is a false premise.
576 : ! Such a replacement creates cyclic dependence on shell_type constructor which then fails. Do not replace it.
577 193886 : failed = isFailedExec(SK_"echo $0 1>"""//filetemp//""" 2>&1")
578 : !write(*,*) filetemp
579 193886 : call setContentsFrom(file = filetemp, contents = shell%name, iostat = iostat, iomsg = errmsg)!, del = .true._LK)
580 193886 : failed = logical(iostat /= 0_IK, LK)
581 193886 : if (failed) then
582 : SET_ERRMSG(__LINE__) ! LCOV_EXCL_LINE
583 : else
584 193886 : if (0 < len(shell%name)) shell%name = shell%name(getSIL(shell%name, LF) : getSIR(shell%name, LF))
585 : ! Assign the component values based on the contents of the command output.
586 193886 : call setShell()
587 193886 : if (shell%is%posix .and. shell%is%sh) then
588 : ! If shell is sh, it may be a symlink, or some other shell renamed. If so, get the target shell type.
589 193886 : failed = isFailedExec(SK_"command -v sh 1>"""//filetemp//""" 2>&1")
590 193886 : if (.not. failed) then
591 193886 : call setContentsFrom(file = filetemp, contents = shell%name, iostat = iostat, iomsg = errmsg, del = .true._LK)
592 193886 : shell%name = shell%name(getSIL(shell%name, LF) : getSIR(shell%name, LF))
593 193886 : failed = logical(iostat /= 0_IK, LK)
594 : end if
595 : ! Fetch the symlink target.
596 193886 : if (.not. failed) then
597 193886 : failed = isFailedExec(SKC_"ls -l """//shell%name//SKC_""" 1>"""//filetemp//""" 2>&1")
598 193886 : if (.not. failed) then
599 193886 : call setContentsFrom(file = filetemp, contents = shell%name, iostat = iostat, iomsg = errmsg, del = .true._LK)
600 193886 : failed = logical(iostat /= 0_IK, LK)
601 193886 : if (.not. failed) call setShell()
602 : end if
603 : end if
604 193886 : if (failed) then
605 : errmsg = PROCEDURE_NAME//SK_": "//trim(errmsg) ! LCOV_EXCL_LINE
606 : shell%name = SKC_"sh" ! LCOV_EXCL_LINE
607 : failed = .false._LK ! LCOV_EXCL_LINE
608 : end if
609 0 : elseif (.not. shell%is%posix) then
610 : ! First, check for fish shell.
611 0 : failed = isFailedGetEnvVar("FISH_VERSION", shell%name, errmsg, length = 63_IK)
612 0 : if (failed) then
613 : errmsg = PROCEDURE_NAME//SK_": "//trim(errmsg) ! LCOV_EXCL_LINE
614 : shell%name = SKC_"" ! LCOV_EXCL_LINE
615 0 : elseif (len_trim(shell%name, IK) > 0_IK) then
616 : !shell%is%posix = .true._LK ! fish is not posix-compliant. Dont you dare setting this to .true.!
617 0 : shell%is%fish = .true._LK
618 0 : shell%name = SKC_"fish"
619 : end if
620 : end if
621 : ! Test for Windows-based terminals.
622 193886 : if (.not. failed) then
623 193886 : if (.not. (shell%is%posix .or. shell%is%fish)) then
624 : ! \note
625 : ! Note PowerShell Core pwsh.exe is also available on Unix systems and recognizes the same syntax as in Windows PowerShell BUT NOT ALL.
626 : ! It also recognizes POXIS commands but not all!
627 : ! Even worse, not all Windows PowerShell commands are defined in Unix PowerShell Core.
628 : ! This is super-confusing. What the hell Microsoft are you doing?!
629 : ! Fortunately the command for CMD shell recognition is platform-independent.
630 : ! LCOV_EXCL_START
631 : failed = isFailedExec(SK_"(dir 2>&1 *`|echo CMD >"""//filetemp//""");&<# rem #>echo PowerShell >"""//filetemp//""" 2>&1")
632 : call setContentsFrom(file = filetemp, contents = shell%name, iostat = iostat, iomsg = errmsg, del = .true._LK)
633 : failed = logical(iostat /= 0_IK, LK)
634 : if (failed) SET_ERRMSG(__LINE__) ! LCOV_EXCL_LINE
635 : if (.not. failed) then
636 : if (index(shell%name, SKC_"CMD", kind = IK) > 0_IK) then
637 : shell%is%windows = .true._LK
638 : shell%is%cmd = .true._LK
639 : elseif (index(shell%name, SKC_"PowerShell", kind = IK) > 0_IK) then
640 : shell%is%powershell = .true._LK
641 : #if WINDOWS_ENABLED
642 : shell%is%windows = .true._LK
643 : #elif DARWIN_ENABLED || LINUX_ENABLED
644 : shell%is%posix = .true._LK
645 : #else
646 : failed = isFailedGetEnvVar(SK_"OS", basetemp, errmsg, length = 10_IK)
647 : if (failed) then
648 : SET_ERRMSG(__LINE__)
649 : else
650 : shell%is%windows = index(getStrLower(basetemp), SK_"windows") /= 0)
651 : shell%is%posix = .not. shell%is%windows
652 : end if
653 : #endif
654 : end if
655 : end if
656 : end if
657 : if (.not. failed) then
658 : if (shell%is%windows) then
659 : shell%dirseps = DIR_SEP_WINDOWS_ALL
660 : shell%pathsep = PATH_SEP_WINDOWS
661 : shell%dirsep = DIR_SEP_WINDOWS
662 : elseif (shell%is%posix .or. shell%is%fish) then
663 : shell%dirseps = DIR_SEP_POSIX_ALL
664 : shell%pathsep = PATH_SEP_POSIX
665 : shell%dirsep = DIR_SEP_POSIX
666 : else
667 : SET_ERRMSG(__LINE__) ! LCOV_EXCL_LINE
668 : failed = .true._LK ! LCOV_EXCL_LINE
669 : end if
670 : ! Cache the results.
671 : mc_shell%shell_type = shell
672 : end if
673 : end if
674 : end if
675 : end if
676 : end if
677 :
678 : contains
679 :
680 : subroutine setShell()
681 : ! Do **not** change the order of the following name checks.
682 : if (index(shell%name, SKC_"bash", kind = IK) > 0_IK) then
683 : shell%name = SKC_"bash"
684 : shell%is%sh = .false._LK
685 : shell%is%bash = .true._LK
686 : shell%is%posix = .true._LK
687 : elseif (index(shell%name, SKC_"dash", kind = IK) > 0_IK) then
688 : shell%name = SKC_"dash"
689 : shell%is%sh = .false._LK
690 : shell%is%dash = .true._LK
691 : shell%is%posix = .true._LK
692 : elseif (index(shell%name, SKC_"yash", kind = IK) > 0_IK) then
693 : shell%name = SKC_"yash"
694 : shell%is%sh = .false._LK
695 : shell%is%yash = .true._LK
696 : shell%is%posix = .true._LK
697 : elseif (index(shell%name, SKC_"ash", kind = IK) > 0_IK) then
698 : shell%name = SKC_"ash"
699 : shell%is%sh = .false._LK
700 : shell%is%ash = .true._LK
701 : shell%is%posix = .true._LK
702 : elseif (index(shell%name, SKC_"tcsh", kind = IK) > 0_IK) then
703 : shell%name = SKC_"tcsh"
704 : shell%is%sh = .false._LK
705 : shell%is%tcsh = .true._LK
706 : shell%is%posix = .true._LK
707 : elseif (index(shell%name, SKC_"csh", kind = IK) > 0_IK) then
708 : shell%name = SKC_"csh"
709 : shell%is%sh = .false._LK
710 : shell%is%csh = .true._LK
711 : shell%is%posix = .true._LK
712 : elseif (index(shell%name, SKC_"ksh", kind = IK) > 0_IK) then
713 : shell%name = SKC_"ksh"
714 : shell%is%sh = .false._LK
715 : shell%is%ksh = .true._LK
716 : shell%is%posix = .true._LK
717 : elseif (index(shell%name, SKC_"zsh", kind = IK) > 0_IK) then
718 : shell%name = SKC_"zsh"
719 : shell%is%sh = .false._LK
720 : shell%is%zsh = .true._LK
721 : shell%is%posix = .true._LK
722 : elseif (index(shell%name, SKC_"sh", kind = IK) > 0_IK) then
723 : shell%name = SKC_"sh"
724 : shell%is%sh = .true._LK
725 : shell%is%posix = .true._LK
726 : end if
727 : end subroutine
728 :
729 : end procedure
730 :
731 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
732 :
733 : module procedure isFailedGetEnvVar
734 : character(LEN_IOMSG, SK) :: errmsg
735 : errmsg = SK_""
736 : failed = isFailedGetEnvVarMsg(name, value, errmsg, length)
737 : end procedure
738 :
739 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
740 :
741 : module procedure isFailedGetEnvVarMsg
742 :
743 : use pm_kind, only: SKC => SK
744 : use pm_val2str, only: getStr
745 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@isFailedGetEnvVarMsg()"
746 : integer :: status, lengthReal
747 : integer(IK) :: lenVal
748 :
749 : if (present(length)) then
750 : CHECK_ASSERTION(__LINE__, 0_IK < length, PROCEDURE_NAME//SK_": The input `length` value must be a positive integer. length = "//getStr(length)) ! fpp
751 : lenVal = length
752 : else
753 : lenVal = 8191_IK ! 2**13 - 1
754 : end if
755 :
756 : allocate(character(lenVal, SKC) :: value, stat = status)
757 : failed = logical(status /= 0, LK)
758 : if (failed) then
759 : errmsg = PROCEDURE_NAME//SK_": Fortran runtime error: Allocation of value failed with size = "//getStr(lenVal)//SK_". stat = "//getStr(status)//SK_"." ! LCOV_EXCL_LINE
760 : !value = SKC_"" ! LCOV_EXCL_LINE
761 : return ! LCOV_EXCL_LINE
762 : end if
763 :
764 : failed = logical(name == SKC_"", LK)
765 : if (failed) then
766 : errmsg = PROCEDURE_NAME//SK_": Fortran runtime error: Zero-length string passed as name to get_environment_variable()."
767 : !value = SK_""
768 : return
769 : end if
770 :
771 : loopAdjustLength: do
772 : call get_environment_variable(name, value, lengthReal, status)
773 : if (status == 0) then
774 : if (lengthReal < len(value)) value = value(1 : lengthReal)
775 : return
776 : elseif (status == +1) then ! the environment variable does not exist.
777 : failed = .false._LK
778 : !value = SK_""
779 : return
780 : elseif (status == -1) then ! the value argument is present but too short.
781 : deallocate(value)
782 : lenVal = lenVal * 2_IK
783 : allocate(character(lenVal, SK) :: value)
784 : cycle loopAdjustLength
785 : elseif (status == +2) then
786 : failed = .true._LK ! LCOV_EXCL_LINE
787 : errmsg = PROCEDURE_NAME//SK_": Failed to fetch the value of environment variable """//name//""". The processor does not support environment variables. status = "//getStr(status) ! LCOV_EXCL_LINE
788 : !value = SK_"" ! LCOV_EXCL_LINE
789 : return ! LCOV_EXCL_LINE
790 : elseif (status > +2) then
791 : failed = .true._LK ! LCOV_EXCL_LINE
792 : errmsg = PROCEDURE_NAME//SK_": Unknown error occurred while fetching the value of the environment variable """//name//""". status = "//getStr(status) ! LCOV_EXCL_LINE
793 : !value = SK_"" ! LCOV_EXCL_LINE
794 : return ! LCOV_EXCL_LINE
795 : else
796 : error stop "How on Earth such an error value could happen?! Hey compiler, you have violated the 2018 Fortran Standard. status = "//getStr(status) ! LCOV_EXCL_LINE
797 : end if
798 : end do loopAdjustLength
799 :
800 : end procedure
801 :
802 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
803 :
804 : module procedure isFailedPutEnvVar
805 : ! \warning : The input `dir` must be of default character kind.
806 : use iso_c_binding, only: c_null_char, c_int
807 : #if WINDOWS_ENABLED
808 : interface ! See WIN32 API for details of `_putenv_s`, `_wputenv_s`.
809 : function setEnvVar(name, value) result(stat) bind(C, name = "_putenv_s")
810 : use iso_c_binding, only: c_char, c_int
811 : character(1,c_char), intent(in) :: name(*), value(*)
812 : integer(c_int) :: stat
813 : end function
814 : end interface
815 : failed = logical(setEnvVar(name//c_null_char, value//c_null_char) /= int(0, c_int), LK)
816 : #else
817 : integer(c_int), parameter :: OVERWRITE_ENABLED = int(1, c_int)
818 : interface
819 : function setEnvVar(name, value, overwrite) result(stat) bind(C, name = "setenv")
820 : use iso_c_binding, only: c_char, c_int
821 : character(1,c_char), intent(in) :: name(*), value(*)
822 : integer(c_int), intent(in) :: overwrite
823 : integer(c_int) :: stat
824 : end function
825 : end interface
826 : failed = logical(setEnvVar(name//c_null_char, value//c_null_char, OVERWRITE_ENABLED) /= int(0, c_int), LK)
827 : #endif
828 : end procedure
829 :
830 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
831 :
832 : #define isFailedGetShellShape_ENABLED 1
833 : module procedure isFailedGetShellShape
834 : #include "pm_sysShell@routines.inc.F90"
835 : end procedure
836 : #undef isFailedGetShellShape_ENABLED
837 :
838 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
839 :
840 : #define isFailedGetShellWidth_ENABLED 1
841 : module procedure isFailedGetShellWidth
842 : #include "pm_sysShell@routines.inc.F90"
843 : end procedure
844 : #undef isFailedGetShellWidth_ENABLED
845 :
846 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
847 :
848 : #define isFailedGetShellHeight_ENABLED 1
849 : module procedure isFailedGetShellHeight
850 : #include "pm_sysShell@routines.inc.F90"
851 : end procedure
852 : #undef isFailedGetShellHeight_ENABLED
853 :
854 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
855 :
856 : #undef CHECK_ASSERTION
857 :
858 : end submodule routines
|
