Skip to content

Commit cd9b636

Browse files
authored
Merge branch 'fortran-lang:master' into io_delete_file
2 parents 5256fc0 + 2bdc50e commit cd9b636

20 files changed

+745
-93
lines changed

config/cmake/Findtest-drive.cmake

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -123,7 +123,7 @@ foreach(method ${${_pkg}_FIND_METHOD})
123123

124124
# We need the module directory in the subproject before we finish the configure stage
125125
if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include")
126-
make_directory("${${_pkg}_BINARY_DIR}/include")
126+
file(MAKE_DIRECTORY "${${_pkg}_BINARY_DIR}/include")
127127
endif()
128128

129129
break()
@@ -147,7 +147,7 @@ foreach(method ${${_pkg}_FIND_METHOD})
147147
FetchContent_GetProperties("${_lib}" SOURCE_DIR "${_pkg}_SOURCE_DIR")
148148
FetchContent_GetProperties("${_lib}" BINARY_DIR "${_pkg}_BINARY_DIR")
149149
if(NOT EXISTS "${${_pkg}_BINARY_DIR}/include")
150-
make_directory("${${_pkg}_BINARY_DIR}/include")
150+
file(MAKE_DIRECTORY "${${_pkg}_BINARY_DIR}/include")
151151
endif()
152152

153153
break()

doc/specs/stdlib_system.md

Lines changed: 157 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -335,3 +335,160 @@ Returns a `logical` flag: `.true.` if the system is Windows, or `.false.` otherw
335335
```fortran
336336
{!example/system/example_process_1.f90!}
337337
```
338+
339+
## `get_runtime_os` - Determine the OS type at runtime
340+
341+
### Status
342+
343+
Experimental
344+
345+
### Description
346+
347+
`get_runtime_os` inspects the runtime environment to identify the current OS type. It evaluates environment variables (`OSTYPE`, `OS`) and checks for specific files associated with known operating systems.
348+
The supported OS types are `integer, parameter` variables stored in the `stdlib_system` module:
349+
350+
- **Linux** (`OS_LINUX`)
351+
- **macOS** (`OS_MACOS`)
352+
- **Windows** (`OS_WINDOWS`)
353+
- **Cygwin** (`OS_CYGWIN`)
354+
- **Solaris** (`OS_SOLARIS`)
355+
- **FreeBSD** (`OS_FREEBSD`)
356+
- **OpenBSD** (`OS_OPENBSD`)
357+
358+
If the OS cannot be identified, the function returns `OS_UNKNOWN`.
359+
360+
### Syntax
361+
362+
`os = [[stdlib_system(module):get_runtime_os(function)]]()`
363+
364+
### Class
365+
366+
Function
367+
368+
### Arguments
369+
370+
None.
371+
372+
### Return Value
373+
374+
Returns one of the `integer` `OS_*` parameters representing the OS type, from the `stdlib_system` module, or `OS_UNKNOWN` if undetermined.
375+
376+
### Example
377+
378+
```fortran
379+
{!example/system/example_get_runtime_os.f90!}
380+
```
381+
382+
---
383+
384+
## `OS_TYPE` - Cached OS type retrieval
385+
386+
### Status
387+
388+
Experimental
389+
390+
### Description
391+
392+
`OS_TYPE` provides a cached result of the `get_runtime_os` function. The OS type is determined during the first invocation and stored in a static variable.
393+
Subsequent calls reuse the cached value, making this function highly efficient.
394+
395+
This caching mechanism ensures negligible overhead for repeated calls, unlike `get_runtime_os`, which performs a full runtime inspection.
396+
397+
### Syntax
398+
399+
`os = [[stdlib_system(module):OS_TYPE(function)]]()`
400+
401+
### Class
402+
403+
Function
404+
405+
### Arguments
406+
407+
None.
408+
409+
### Return Value
410+
411+
Returns one of the `integer` `OS_*` parameters representing the OS type, from the `stdlib_system` module, or `OS_UNKNOWN` if undetermined.
412+
413+
### Example
414+
415+
```fortran
416+
{!example/system/example_os_type.f90!}
417+
```
418+
419+
---
420+
421+
## `is_directory` - Test if a path is a directory
422+
423+
### Status
424+
425+
Experimental
426+
427+
### Description
428+
429+
This function checks if a specified file system path is a directory.
430+
It is designed to work across multiple platforms. On Windows, paths with both forward `/` and backward `\` slashes are accepted.
431+
432+
### Syntax
433+
434+
`result = [[stdlib_io(module):is_directory(function)]] (path)`
435+
436+
### Class
437+
438+
Function
439+
440+
### Arguments
441+
442+
`path`: Shall be a character string containing the file system path to evaluate. It is an `intent(in)` argument.
443+
444+
### Return values
445+
446+
The function returns a `logical` value:
447+
448+
- `.true.` if the path matches an existing directory.
449+
- `.false.` otherwise, or if the operating system is unsupported.
450+
451+
### Example
452+
453+
```fortran
454+
{!example/system/example_is_directory.f90!}
455+
```
456+
457+
---
458+
459+
## `null_device` - Return the null device file path
460+
461+
### Status
462+
463+
Experimental
464+
465+
### Description
466+
467+
This function returns the file path of the null device, which is a special file used to discard any data written to it.
468+
It reads as an empty file. The null device's path varies by operating system:
469+
- On Windows, the null device is represented as `NUL`.
470+
- On UNIX-like systems (Linux, macOS), the null device is represented as `/dev/null`.
471+
472+
### Syntax
473+
474+
`path = [[stdlib_system(module):null_device(function)]]()`
475+
476+
### Class
477+
478+
Function
479+
480+
### Arguments
481+
482+
None.
483+
484+
### Return Value
485+
486+
- **Type:** `character(:), allocatable`
487+
- Returns the null device file path as a character string, appropriate for the operating system.
488+
489+
### Example
490+
491+
```fortran
492+
{!example/system/example_null_device.f90!}
493+
```
494+

example/system/CMakeLists.txt

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,7 @@
1+
ADD_EXAMPLE(get_runtime_os)
2+
ADD_EXAMPLE(is_directory)
3+
ADD_EXAMPLE(null_device)
4+
ADD_EXAMPLE(os_type)
15
ADD_EXAMPLE(process_1)
26
ADD_EXAMPLE(process_2)
37
ADD_EXAMPLE(process_3)
Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
! Demonstrate usage of (non-cached) runtime OS query
2+
program example_get_runtime_os
3+
use stdlib_system, only: OS_NAME, get_runtime_os
4+
implicit none
5+
6+
! Runtime OS detection (full inspection)
7+
print *, "Runtime OS Type: ", OS_NAME(get_runtime_os())
8+
9+
end program example_get_runtime_os
Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
! Demonstrate usage of `is_directory`
2+
program example_is_directory
3+
use stdlib_system, only: is_directory
4+
implicit none
5+
! Test a directory path
6+
if (is_directory("/path/to/check")) then
7+
print *, "The specified path is a directory."
8+
else
9+
print *, "The specified path is not a directory."
10+
end if
11+
end program example_is_directory
Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
! Showcase usage of the null device
2+
program example_null_device
3+
use stdlib_system, only: null_device
4+
use iso_fortran_env, only: output_unit
5+
implicit none
6+
integer :: unit
7+
logical :: screen_output = .false.
8+
9+
if (screen_output) then
10+
unit = output_unit
11+
else
12+
! Write to the null device if no screen output is wanted
13+
open(newunit=unit,file=null_device())
14+
endif
15+
16+
write(unit,*) "Hello, world!"
17+
18+
if (.not.screen_output) close(unit)
19+
20+
end program example_null_device

example/system/example_os_type.f90

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
! Demonstrate OS detection
2+
program example_os_type
3+
use stdlib_system, only: OS_TYPE, OS_NAME
4+
implicit none
5+
6+
integer :: current_os
7+
8+
! Cached OS detection
9+
current_os = OS_TYPE()
10+
print *, "Current OS Type: ", OS_NAME(current_os)
11+
12+
end program example_os_type

src/CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -145,7 +145,7 @@ set(LIB_MOD_DIR ${CMAKE_CURRENT_BINARY_DIR}/mod_files/)
145145
# We need the module directory before we finish the configure stage since the
146146
# build interface might resolve before the module directory is generated by CMake
147147
if(NOT EXISTS "${LIB_MOD_DIR}")
148-
make_directory("${LIB_MOD_DIR}")
148+
file(MAKE_DIRECTORY "${LIB_MOD_DIR}")
149149
endif()
150150

151151
set_target_properties(${PROJECT_NAME} PROPERTIES

src/stdlib_constants.fypp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ module stdlib_constants
4040
real(dp), parameter, public :: epsilon_0 = VACUUM_ELECTRIC_PERMITTIVITY%value !! vacuum mag. permeability
4141
real(dp), parameter, public :: h = PLANCK_CONSTANT%value !! Planck constant
4242
real(dp), parameter, public :: Planck = PLANCK_CONSTANT%value !! Planck constant
43-
real(dp), parameter, public :: hbar = PLANCK_CONSTANT%value / PI_dp !! Reduced Planck constant
43+
real(dp), parameter, public :: hbar = PLANCK_CONSTANT%value / (2.0_dp * PI_dp) !! Reduced Planck constant
4444
real(dp), parameter, public :: G = NEWTONIAN_CONSTANT_OF_GRAVITATION%value !! Newtonian constant of gravitation
4545
real(dp), parameter, public :: gravitation_constant = NEWTONIAN_CONSTANT_OF_GRAVITATION%value !! Newtonian constant of gravitation
4646
real(dp), parameter, public :: g2 = STANDARD_ACCELERATION_OF_GRAVITY%value !! Standard acceleration of gravity

src/stdlib_io.fypp

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -169,6 +169,7 @@ contains
169169

170170
if (ios/=0) then
171171
write(msgout,1) trim(iomsg),i,trim(filename)
172+
1 format('loadtxt: error <',a,'> skipping line ',i0,' of ',a,'.')
172173
call error_stop(msg=trim(msgout))
173174
end if
174175

@@ -189,7 +190,7 @@ contains
189190
read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
190191

191192
if (ios/=0) then
192-
write(msgout,1) trim(iomsg),size(d,2),i,trim(filename)
193+
write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
193194
call error_stop(msg=trim(msgout))
194195
end if
195196

@@ -200,7 +201,7 @@ contains
200201
read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)
201202

202203
if (ios/=0) then
203-
write(msgout,1) trim(iomsg),size(d,2),i,trim(filename)
204+
write(msgout,2) trim(iomsg),size(d,2),i,trim(filename)
204205
call error_stop(msg=trim(msgout))
205206
end if
206207

@@ -209,7 +210,7 @@ contains
209210

210211
close(s)
211212

212-
1 format('loadtxt: error <',a,'> reading ',i0,' values from line ',i0,' of ',a,'.')
213+
2 format('loadtxt: error <',a,'> reading ',i0,' values from line ',i0,' of ',a,'.')
213214

214215
end subroutine loadtxt_${t1[0]}$${k1}$
215216
#:endfor

src/stdlib_math_is_close.fypp

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ contains
2323
equal_nan_ = optval(equal_nan, .false.)
2424

2525
if (ieee_is_nan(a) .or. ieee_is_nan(b)) then
26-
close = merge(.true., .false., equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b))
26+
close = equal_nan_ .and. ieee_is_nan(a) .and. ieee_is_nan(b)
2727
else
2828
close = abs(a - b) <= max( abs(optval(rel_tol, sqrt_eps_${k1}$)*max(abs(a), abs(b))), &
2929
abs(optval(abs_tol, 0.0_${k1}$)) )

src/stdlib_specialfunctions_gamma.fypp

Lines changed: 8 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
#:set CI_KINDS_TYPES = INT_KINDS_TYPES + C_KINDS_TYPES
55
module stdlib_specialfunctions_gamma
66
use iso_fortran_env, only : qp => real128
7+
use ieee_arithmetic, only: ieee_value, ieee_quiet_nan
78
use stdlib_kinds, only : sp, dp, int8, int16, int32, int64
89
use stdlib_error, only : error_stop
910

@@ -575,9 +576,9 @@ contains
575576
! Fortran 90 program by Jim-215-Fisher
576577
!
577578
${t1}$, intent(in) :: p, x
578-
integer :: n, m
579+
integer :: n
579580

580-
${t2}$ :: res, p_lim, a, b, g, c, d, y, ss
581+
${t2}$ :: res, p_lim, a, b, g, c, d, y
581582
${t2}$, parameter :: zero = 0.0_${k2}$, one = 1.0_${k2}$
582583
${t2}$, parameter :: dm = tiny(1.0_${k2}$) * 10 ** 6
583584
${t1}$, parameter :: zero_k1 = 0.0_${k1}$
@@ -603,6 +604,9 @@ contains
603604
call error_stop("Error(gpx): Incomplete gamma function with " &
604605
//"negative x must come with a whole number p not too small")
605606

607+
if(x < zero_k1) call error_stop("Error(gpx): Incomplete gamma" &
608+
// " function with negative x must have an integer parameter p")
609+
606610
if(p >= p_lim) then !use modified Lentz method of continued fraction
607611
!for eq. (15) in the above reference.
608612
a = one
@@ -668,30 +672,9 @@ contains
668672

669673
end do
670674

671-
else !Algorithm 2 in the reference
672-
673-
m = nint(ss)
674-
a = - x
675-
c = one / a
676-
d = p - one
677-
b = c * (a - d)
678-
n = 1
679-
680-
do
681-
682-
c = d * (d - one) / (a * a)
683-
d = d - 2
684-
y = c * (a - d)
685-
b = b + y
686-
n = n + 1
687-
688-
if(n > int((p - 2) / 2) .or. y < b * tol_${k2}$) exit
689-
690-
end do
691-
692-
if(y >= b * tol_${k2}$ .and. mod(m , 2) /= 0) b = b + d * c / a
675+
else
676+
g = ieee_value(1._${k1}$, ieee_quiet_nan)
693677

694-
g = ((-1) ** m * exp(-a + log_gamma(p) - (p - 1) * log(a)) + b) / a
695678
end if
696679

697680
res = g

0 commit comments

Comments
 (0)