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_sysInfo](@ref pm_sysInfo).
19 : !>
20 : !> \finmain
21 : !>
22 : !> \author
23 : !> \FatemehBagheri, Wednesday 12:20 AM, October 13, 2021, Dallas, TX
24 :
25 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 :
27 : !> \cond excluded
28 : ! The Intel FPP defines `linux=1` which conflicts with the `linux` component of `kernelis_type` below.
29 : #if __INTEL_COMPILER
30 : #undef linux
31 : #endif
32 : !> \endcond excluded
33 :
34 : submodule (pm_sysInfo) routines ! LCOV_EXCL_LINE
35 :
36 : #if CHECK_ENABLED
37 : use pm_err, only: getFine
38 : use pm_val2str, only: getStr
39 : use pm_err, only: setAsserted
40 : #define CHECK_ASSERTION(LINE,ASSERTION,MSG) \
41 : call setAsserted(ASSERTION,getFine(__FILE__,LINE)//MODULE_NAME//MSG);
42 : #else
43 : #define CHECK_ASSERTION(LINE,ASSERTION,MSG) continue;
44 : #endif
45 :
46 : use pm_io, only: LEN_IOMSG
47 : use pm_strASCII, only: getStrLower
48 : use pm_sysShell, only: isFailedGetEnvVar
49 : use pm_sysShell, only: isFailedGetOutput
50 :
51 : implicit none
52 :
53 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
54 :
55 : !> \brief
56 : !> The scalar `private` module object of type [kernel_type](@ref pm_sysInfo::kernel_type).
57 : !>
58 : !> \details
59 : !> This object is set only once throughout the life of the program to avoid costly redundant construction of OS objects.<br>
60 : !> It is set by and exclusively used within the routines of this submodule and nowhere else.<br>
61 : !> The allocation status of the object is used as an indicator of its initialization.<br>
62 : !>
63 : !> \finmain{kernel_type}
64 : !>
65 : !> \author
66 : !> \AmirShahmoradi, Tuesday March 7, 2017, 3:50 AM, Institute for Computational Engineering and Sciences (ICES), The University of Texas at Austin
67 : type(kernel_type), allocatable :: mc_kernel
68 :
69 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
70 :
71 : contains
72 :
73 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
74 :
75 24 : function isFailedInitOS(errmsg) result(failed)
76 : use pm_kind, only: SKC => SK
77 : character(*,SKC), intent(inout), optional :: errmsg
78 : logical(LK) :: failed
79 24 : failed = .not. allocated(mc_kernel)
80 24 : if (failed) then
81 16 : if (present(errmsg)) then
82 16 : mc_kernel = kernel_type(failed, errmsg)
83 : else
84 0 : mc_kernel = kernel_type(failed)
85 : end if
86 16 : if (failed) deallocate(mc_kernel)
87 : end if
88 24 : end function
89 :
90 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
91 :
92 1 : module procedure constructKernelIs
93 : character(255, SK) :: errmsg
94 : logical(LK) :: failed
95 1 : errmsg = SK_""
96 1 : kernelis = kernelis_type(failed, errmsg)
97 : if (failed) error stop MODULE_NAME//SK_"@constructKernelIs(): "//trim(errmsg) ! LCOV_EXCL_LINE
98 1 : end procedure
99 :
100 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
101 :
102 1 : module procedure constructKernelIsFailed
103 : character(255, SK) :: errmsg
104 1 : errmsg = SK_""
105 1 : kernelis = kernelis_type(failed, errmsg)
106 1 : end procedure
107 :
108 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
109 :
110 3 : module procedure constructKernelIsFailedMsg
111 3 : if (allocated(mc_kernel)) then
112 2 : kernelis = mc_kernel%is
113 2 : failed = .false._LK
114 : else
115 1 : mc_kernel = kernel_type(failed, errmsg)
116 1 : if (allocated(mc_kernel)) then
117 1 : kernelis = mc_kernel%is
118 : else
119 : errmsg = MODULE_NAME//SK_"@constructKernelIsFailedMsg(): "//trim(errmsg) ! LCOV_EXCL_LINE
120 : return ! LCOV_EXCL_LINE
121 : end if
122 : end if
123 6 : end procedure
124 :
125 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
126 :
127 1 : module procedure constructKernel
128 : character(255, SK) :: errmsg
129 : logical(LK) :: failed
130 1 : errmsg = SK_""
131 1 : kernel = kernel_type(failed, errmsg)
132 : if (failed) error stop MODULE_NAME//SK_"@constructKernel(): "//trim(errmsg) ! LCOV_EXCL_LINE
133 1 : end procedure
134 :
135 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
136 :
137 1 : module procedure constructKernelFailed
138 : character(31, SK) :: errmsg
139 1 : errmsg = SK_""
140 1 : kernel = kernel_type(failed, errmsg)
141 1 : end procedure
142 :
143 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
144 :
145 20 : module procedure constructKernelFailedMsg
146 : use pm_kind, only: SKC => SK
147 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@constructKernel()"
148 20 : if (allocated(mc_kernel)) then
149 19 : failed = .false._LK
150 19 : kernel = mc_kernel
151 : else
152 : #if MSYS_ENABLED
153 : kernel%name = "MSYS"
154 : kernel%is%msys = .true._LK
155 : kernel%is%windows = .true._LK
156 : failed = .false._LK
157 : #elif MINGW_ENABLED
158 : kernel%name = "MinGW"
159 : kernel%is%mingw = .true._LK
160 : kernel%is%windows = .true._LK
161 : failed = .false._LK
162 : #elif CYGWIN_ENABLED
163 : kernel%name = "Cygwin"
164 : kernel%is%cygwin = .true._LK
165 : kernel%is%windows = .true._LK
166 : failed = .false._LK
167 : #elif WINDOWS_ENABLED
168 : kernel%name = "Windows"
169 : kernel%is%windows = .true._LK
170 : failed = .false._LK
171 : #elif DARWIN_ENABLED
172 : kernel%name = "Darwin"
173 : kernel%is%darwin = .true._LK
174 : failed = .false._LK
175 : #elif LINUX_ENABLED
176 1 : kernel%name = "Linux"
177 1 : kernel%is%linux = .true._LK
178 1 : failed = .false._LK
179 : #else
180 : block
181 : character(:,SKC), allocatable :: nameLower
182 : ! Lets infer it through the runtime shell. Firs assume Window OS.
183 : failed = isFailedGetEnvVar(name = SK_"OS", value = kernel%name, errmsg, length = length)
184 : if (failed) then
185 : ! assume unix-like.
186 : failed = isFailedGetEnvVar(name = SK_"OSTYPE", value = kernel%name, errmsg, length = length)
187 : if (failed) then
188 : ! Try one last time with the universal UNIX command `uname`.
189 : failed = isFailedGetOutput(SKC_"uname", kernel%name, errmsg)
190 : if (failed) then
191 : errmsg = PROCEDURE_NAME//SK_": "//trim(errmsg) ! LCOV_EXCL_LINE
192 : kernel%name = SKC_"" ! LCOV_EXCL_LINE
193 : return ! LCOV_EXCL_LINE
194 : end if
195 : end if
196 : end if
197 : nameLower = getStrLower(kernel%name)
198 : kernel%is%freebsd = logical(index(nameLower, SKC_"freebsd"), LK)
199 : kernel%is%darwin = logical(index(nameLower, SKC_"darwin"), LK)
200 : kernel%is%linux = logical(index(nameLower, SKC_"linux"), LK)
201 : kernel%is%msys = logical(index(nameLower, SKC_"msys"), LK)
202 : kernel%is%mingw = logical(index(nameLower, SKC_"mingw"), LK)
203 : kernel%is%cygwin = logical(index(nameLower, SKC_"cygwin"), LK)
204 : kernel%is%windows = logical(index(nameLower, SKC_"windows"), LK) .or. kernel%is%msys .or. kernel%is%mingw .or. kernel%is%cygwin
205 : end block
206 : #endif
207 1 : if (.not. allocated(mc_kernel)) allocate(mc_kernel, source = kernel)
208 : !mc_kernel = kernel
209 : end if
210 20 : end procedure
211 :
212 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
213 :
214 1 : module procedure isKernelWindows
215 : #if WINDOWS_ENABLED
216 : itis = .true._LK
217 : #else
218 : logical(LK) :: failed
219 : character(LEN_IOMSG, SK) :: errmsg
220 1 : itis = isKernelWindows(failed, errmsg)
221 1 : if (failed) error stop MODULE_NAME//SK_"@isKernelWindows(): "//trim(errmsg)
222 : #endif
223 1 : end procedure
224 :
225 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
226 :
227 1 : module procedure isKernelWindowsFailed
228 : character(LEN_IOMSG, SK) :: errmsg
229 1 : itis = isKernelWindows(failed, errmsg)
230 1 : end procedure
231 :
232 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
233 :
234 : #define isKernelWindows_ENABLED 1
235 3 : module procedure isKernelWindowsFailedMsg
236 : #include "pm_sysInfo@routines.inc.F90"
237 3 : end procedure
238 : #undef isKernelWindows_ENABLED
239 :
240 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
241 :
242 1 : module procedure isKernelDarwin
243 : #if DARWIN_ENABLED
244 : itis = .true._LK
245 : #else
246 : logical(LK) :: failed
247 : character(LEN_IOMSG, SK) :: errmsg
248 1 : itis = isKernelDarwin(failed, errmsg)
249 1 : if (failed) error stop MODULE_NAME//SK_"@isKernelDarwin(): "//trim(errmsg)
250 : #endif
251 1 : end procedure
252 :
253 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
254 :
255 1 : module procedure isKernelDarwinFailed
256 : character(LEN_IOMSG, SK) :: errmsg
257 1 : itis = isKernelDarwin(failed, errmsg)
258 1 : end procedure
259 :
260 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
261 :
262 : #define isKernelDarwin_ENABLED 1
263 3 : module procedure isKernelDarwinFailedMsg
264 : #include "pm_sysInfo@routines.inc.F90"
265 3 : end procedure
266 : #undef isKernelDarwin_ENABLED
267 :
268 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
269 :
270 1 : module procedure isKernelLinux
271 : #if LINUX_ENABLED
272 : itis = .true._LK
273 : #else
274 : logical(LK) :: failed
275 : character(LEN_IOMSG, SK) :: errmsg
276 : itis = isKernelLinux(failed, errmsg)
277 : if (failed) error stop MODULE_NAME//SK_"@isKernelLinux(): "//trim(errmsg)
278 : #endif
279 1 : end procedure
280 :
281 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
282 :
283 1 : module procedure isKernelLinuxFailed
284 : character(LEN_IOMSG, SK) :: errmsg
285 1 : itis = isKernelLinux(failed, errmsg)
286 1 : end procedure
287 :
288 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
289 :
290 : #define isKernelLinux_ENABLED 1
291 2 : module procedure isKernelLinuxFailedMsg
292 : #include "pm_sysInfo@routines.inc.F90"
293 2 : end procedure
294 : #undef isKernelLinux_ENABLED
295 :
296 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
297 :
298 1 : module procedure getSysInfo
299 : use pm_kind, only: SKC => SK
300 : character(LEN_IOMSG,SKC) :: errmsg
301 : logical(LK) :: failed
302 1 : errmsg = SKC_""
303 1 : sysInfo = getSysInfo(failed, errmsg)
304 1 : if (failed) error stop trim(errmsg)
305 1 : end procedure
306 :
307 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
308 :
309 14 : module procedure getSysInfoFailed
310 : use pm_kind, only: SKC => SK
311 : character(LEN_IOMSG,SKC) :: errmsg
312 14 : sysInfo = getSysInfo(failed, errmsg)
313 14 : end procedure
314 :
315 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
316 :
317 16 : module procedure getSysInfoFailedMsg
318 :
319 : use pm_kind, only: SKC => SK
320 : use pm_val2str, only: getStr
321 : use pm_io, only: setContentsFrom
322 : use pm_sysShell, only: isFailedExec
323 : use pm_sysPath, only: getPathTemp
324 : use pm_sysShell, only: shell_type
325 : use pm_container, only: css_type
326 :
327 : character(*,SKC), parameter :: NLC = new_line(SKC_"a")
328 : character(*, SK), parameter :: PROCEDURE_NAME = MODULE_NAME//SK_"@getSysInfo()"
329 16 : character(:,SKC), allocatable :: contents, stderr, stdout, dumper
330 16 : type(css_type) , allocatable :: cmd(:)
331 16 : type(shell_type) :: shell
332 : logical(LK) :: done
333 : integer(IK) :: icmd
334 : integer(IK) :: iostat
335 :
336 16 : sysInfo = SKC_""
337 :
338 : ! Infer the shell type.
339 :
340 16 : shell = shell_type(failed, errmsg)
341 16 : if (failed) then
342 : errmsg = PROCEDURE_NAME//SK_": Failed to create a new file path for system information storage." ! LCOV_EXCL_LINE
343 : return ! LCOV_EXCL_LINE
344 : end if
345 :
346 : ! Define the cache file.
347 : !if (present(cache)) then
348 : ! cache_def = cache
349 : !else
350 : ! ! generate a brand new, non-existing temporary filename.
351 : ! cache_def = getPathTemp(prefix = SK_".sysInfo", failed = failed)
352 : ! if (failed) then
353 : ! if (present(errmsg)) errmsg = PROCEDURE_NAME//SK_": Failed to create a new file path for system information storage." ! LCOV_EXCL_LINE
354 : ! return ! LCOV_EXCL_LINE
355 : ! end if
356 : !end if
357 :
358 : ! Standard error output for error-catching.
359 :
360 : !stderr = SK_" 2> "//cache_def//SK_".stderr"
361 16 : stdout = getPathTemp(prefix = SK_".sysInfo", failed = failed)
362 16 : stderr = stdout//SK_".stderr"
363 16 : dumper = SK_" 1> "//stdout//SK_" 2> "//stderr
364 :
365 : ! Define the shell command.
366 :
367 16 : failed = isFailedInitOS(errmsg)
368 : if (failed) return ! LCOV_EXCL_LINE
369 :
370 16 : if (mc_kernel%is%darwin) then
371 : cmd = [ css_type(SK_"uname -a"//dumper) &
372 : , css_type(SK_"sysctl -a | grep machdep.cpu"//dumper) &
373 : , css_type(SK_"system_profiler SPHardwareDataType"//dumper) &
374 0 : ]
375 16 : elseif (mc_kernel%is%linux .or. mc_kernel%is%freebsd .or. shell%is%posix) then
376 : !command = SK_"uname -a > "//cache_def//SK_"; lshw -short >> "//cache_def//SK_"; lscpu >> "//cache_def
377 : cmd = [ css_type(SK_"uname -a"//dumper) &
378 : , css_type(SK_"lscpu"//dumper//SK_" || cat /proc/cpuinfo"//dumper) &
379 96 : ]
380 0 : elseif (mc_kernel%is%windows .and. shell%is%windows) then
381 0 : cmd = [css_type(SK_"systeminfo"//dumper)]
382 : else
383 : errmsg = PROCEDURE_NAME//SK_": Unrecognized operating system: "//mc_kernel%name ! LCOV_EXCL_LINE
384 : failed = .true._LK ! LCOV_EXCL_LINE
385 : return ! LCOV_EXCL_LINE
386 : end if
387 :
388 : ! Get sysinfo.
389 :
390 : done = .false._LK
391 48 : do icmd = 1, size(cmd, 1, IK)
392 48 : if (.not. isFailedExec(cmd(icmd)%val, cmdmsg = errmsg)) then
393 32 : call setContentsFrom(stdout, contents, iostat, iomsg = errmsg, del = .true._LK)
394 32 : if (iostat == 0_IK) then
395 32 : sysInfo = sysInfo//NLC//contents
396 : done = .true._LK
397 : end if
398 : end if
399 : end do
400 : ! At least one of the loop cycles must succeed to not fail.
401 16 : failed = .not. done
402 16 : if (failed) then
403 : errmsg = PROCEDURE_NAME//SK_": "//trim(errmsg) ! LCOV_EXCL_LINE
404 : return ! LCOV_EXCL_LINE
405 : end if
406 :
407 : ! \todo
408 : ! \warning
409 : ! On some platforms, such as Windows Subsystem for Linux, the CMD exit status might not
410 : ! be returned reliably and therefore, cause `isFailedExec()` to return an error.
411 : ! In such a case, no error for the file copying should be really raised.
412 : ! If the file already exists upon copy action, no error should be raised.
413 : ! Note that this method may have some vulnerabilities, for example, when
414 : ! a file copy is created, but the copy action did not accomplish the
415 : ! task successfully and the copied file is broken.
416 : ! This needs a more robust solution in the future.
417 : !failed = .true._LK ! LCOV_EXCL_LINE
418 : !return ! LCOV_EXCL_LINE
419 :
420 64 : end procedure
421 :
422 : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
423 :
424 : #undef CHECK_ASSERTION
425 :
426 : end submodule routines
|
