Skip to content

Commit 395d0d0

Browse files
interkosmosinterkosmos
committed
Refactoring. Added wrapper. Lower bound of C arrays set to 0.
1 parent 529317c commit 395d0d0

File tree

10 files changed

+89
-87
lines changed

10 files changed

+89
-87
lines changed

‎README.md‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ conditionals (`#ifdef` …).
3939

4040
## Build Instructions
4141

42-
Run either GNU/BSD make or [fpm](https://github.com/fortran-lang/fpm) to build
42+
Run either GNU/BSD make or [FPM](https://github.com/fortran-lang/fpm) to build
4343
the static library `libfortran-unix.a`. Link your Fortran application with
4444
`libfortran-unix.a`, and optionally with `-lpthread` to access POSIX threads, or
4545
`-lrt` to access POSIX message queues.
@@ -62,7 +62,7 @@ Or, set parameter `OS` to either `linux` or `FreeBSD`, and `PREFIX` to `/usr` or
6262
`/usr/local`, for instance:
6363

6464
```
65-
$ make FC=gfortran OS=linux PREFIX=/usr
65+
$ make OS=linux PREFIX=/usr
6666
```
6767

6868
For Intel oneAPI, run:
@@ -82,7 +82,7 @@ $ make install PREFIX=/opt
8282

8383
### Fortran Package Manager
8484

85-
Using fpm, a preprocessor flag has to be passed to GNU Fortran. On FreeBSD:
85+
Using FPM, a preprocessor flag has to be passed to GNU Fortran. On FreeBSD:
8686

8787
```
8888
$ fpm build --profile release --flag "-D__FreeBSD__"

‎examples/uname/uname.f90‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -7,22 +7,22 @@
77
program main
88
use :: unix
99
implicit none
10-
character(len=256) :: sys_name
11-
character(len=256) :: node_name
12-
character(len=256) :: release
13-
character(len=256) :: version
14-
character(len=256) :: machine
15-
integer :: rc
16-
type(c_utsname) :: utsname
10+
character(len=SYS_NMLN) :: sys_name
11+
character(len=SYS_NMLN) :: node_name
12+
character(len=SYS_NMLN) :: release
13+
character(len=SYS_NMLN) :: version
14+
character(len=SYS_NMLN) :: machine
15+
integer :: rc
16+
type(c_utsname) :: utsname
1717

1818
rc = c_uname(utsname)
1919
if (rc /= 0) stop 'Error: uname() failed'
2020

21-
call c_f_str_chars(utsname%sysname, sys_name)
21+
call c_f_str_chars(utsname%sysname, sys_name)
2222
call c_f_str_chars(utsname%nodename, node_name)
23-
call c_f_str_chars(utsname%release, release)
24-
call c_f_str_chars(utsname%version, version)
25-
call c_f_str_chars(utsname%machine, machine)
23+
call c_f_str_chars(utsname%release, release)
24+
call c_f_str_chars(utsname%version, version)
25+
call c_f_str_chars(utsname%machine, machine)
2626

2727
print '("OS name...: ", a)', trim(sys_name)
2828
print '("Node name.: ", a)', trim(node_name)

‎src/unix.f90‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -78,6 +78,7 @@ function f_readdir(dirp)
7878
!! Wrapper function that calls `c_readdir()` and converts the returned
7979
!! C pointer to Fortran pointer.
8080
type(c_ptr), intent(in) :: dirp
81+
8182
type(c_dirent), pointer :: f_readdir
8283
type(c_ptr) :: ptr
8384

@@ -92,17 +93,19 @@ function f_strerror(errnum) result(str)
9293
!! array pointer to Fortran string.
9394
integer, intent(in) :: errnum
9495
character(len=:), allocatable :: str
95-
type(c_ptr) :: ptr
96+
97+
type(c_ptr) :: ptr
9698

9799
ptr = c_strerror(errnum)
98100
call c_f_str_ptr(ptr, str)
99101
end function f_strerror
100102

101103
subroutine c_f_str_chars(c_str, f_str)
102104
!! Copies a C string, passed as a C char array, to a Fortran string.
103-
character(kind=c_char), intent(in) :: c_str(:)
104-
character(len=size(c_str)), intent(out) :: f_str
105-
integer :: i
105+
character(kind=c_char), intent(inout) :: c_str(:)
106+
character(len=size(c_str)), intent(out) :: f_str
107+
108+
integer :: i
106109

107110
f_str = ' '
108111

@@ -141,7 +144,8 @@ subroutine f_c_str_chars(f_str, c_str)
141144
!! Copies a Fortran string to a C char array.
142145
character(len=*), intent(in) :: f_str
143146
character(kind=c_char), intent(out) :: c_str(len(f_str))
144-
integer :: i
147+
148+
integer :: i
145149

146150
c_str = c_null_char
147151

‎src/unix_dirent.F90‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -17,23 +17,23 @@ module unix_dirent
1717
#if defined (__linux__)
1818

1919
type, bind(c), public :: c_dirent
20-
integer(kind=c_int64_t) :: d_ino = 0_c_int64_t
21-
integer(kind=c_int64_t) :: d_off = 0_c_int64_t
22-
integer(kind=c_int16_t) :: d_reclen = 0_c_int16_t
23-
integer(kind=c_int8_t) :: d_type = 0_c_int8_t
24-
character(kind=c_char) :: d_name(256) = c_null_char
20+
integer(kind=c_int64_t) :: d_ino = 0_c_int64_t
21+
integer(kind=c_int64_t) :: d_off = 0_c_int64_t
22+
integer(kind=c_int16_t) :: d_reclen = 0_c_int16_t
23+
integer(kind=c_int8_t) :: d_type = 0_c_int8_t
24+
character(kind=c_char) :: d_name(0:255) = c_null_char
2525
end type c_dirent
2626

2727
#elif defined (__FreeBSD__)
2828

2929
type, bind(c), public :: c_dirent
30-
integer(kind=c_int64_t) :: d_fileno = 0_c_int64_t
31-
integer(kind=c_int64_t) :: d_off = 0_c_int64_t
32-
integer(kind=c_int16_t) :: d_reclen = 0_c_int16_t
33-
integer(kind=c_int8_t) :: d_type = 0_c_int8_t
34-
integer(kind=c_int8_t) :: d_namlen = 0_c_int8_t
35-
integer(kind=c_int32_t), private :: d_pad0 = 0_c_int32_t
36-
character(kind=c_char) :: d_name(256) = c_null_char
30+
integer(kind=c_int64_t) :: d_fileno = 0_c_int64_t
31+
integer(kind=c_int64_t) :: d_off = 0_c_int64_t
32+
integer(kind=c_int16_t) :: d_reclen = 0_c_int16_t
33+
integer(kind=c_int8_t) :: d_type = 0_c_int8_t
34+
integer(kind=c_int8_t) :: d_namlen = 0_c_int8_t
35+
integer(kind=c_int32_t), private :: d_pad0 = 0_c_int32_t
36+
character(kind=c_char) :: d_name(0:255) = c_null_char
3737
end type c_dirent
3838

3939
#endif

‎src/unix_fcntl.F90‎

Lines changed: 2 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -24,12 +24,6 @@ module unix_fcntl
2424

2525
integer(kind=c_int), parameter, public :: O_CLOEXEC = int(o'02000000')
2626

27-
integer(kind=c_int), parameter, public :: F_DUPFD = 0
28-
integer(kind=c_int), parameter, public :: F_GETFD = 1
29-
integer(kind=c_int), parameter, public :: F_SETFD = 2
30-
integer(kind=c_int), parameter, public :: F_GETFL = 3
31-
integer(kind=c_int), parameter, public :: F_SETFL = 4
32-
3327
#elif defined (__FreeBSD__)
3428

3529
integer(kind=c_int), parameter, public :: O_RDONLY = int(z'0000') ! Open for reading only.
@@ -47,14 +41,14 @@ module unix_fcntl
4741

4842
integer(kind=c_int), parameter, public :: O_CLOEXEC = int(z'00100000')
4943

44+
#endif
45+
5046
integer(kind=c_int), parameter, public :: F_DUPFD = 0 ! Duplicate file descriptor.
5147
integer(kind=c_int), parameter, public :: F_GETFD = 1 ! Get file descriptor flags.
5248
integer(kind=c_int), parameter, public :: F_SETFD = 2 ! Set file descriptor flags.
5349
integer(kind=c_int), parameter, public :: F_GETFL = 3 ! Get file status flags.
5450
integer(kind=c_int), parameter, public :: F_SETFL = 4 ! Set file status flags.
5551

56-
#endif
57-
5852
public :: c_fcntl
5953
public :: c_open
6054

‎src/unix_macro.c‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,11 @@
11
/* unix_macro.c */
22
#include <errno.h>
33
#include <fcntl.h>
4-
#include <sys/ioctl.h>
5-
#include <unistd.h>
64
#include <stdio.h>
5+
#include <sys/ioctl.h>
6+
#include <sys/utsname.h>
77
#include <syslog.h>
8+
#include <unistd.h>
89

910
#ifdef __cplusplus
1011
extern "C" {
@@ -17,6 +18,7 @@ int c_fprintf(FILE *, const char *, const char *);
1718
int c_ioctl(int, unsigned long, void *);
1819
int c_open(const char *, int, mode_t);
1920
int c_scanf(const char *, const char *);
21+
int uname(struct utsname *);
2022
void c_syslog(int, const char *, const char *);
2123

2224
/*******************************************************************************
@@ -69,6 +71,12 @@ int c_scanf(const char *format, const char *arg)
6971
return scanf(format, arg);
7072
}
7173

74+
/* int uname(struct utsname *name) */
75+
int c_uname(struct utsname *name)
76+
{
77+
uname(name);
78+
}
79+
7280
/* void syslog(int priority, const char *format, ...) */
7381
void c_syslog(int priority, const char *format, const char *arg)
7482
{

‎src/unix_netdb.F90‎

Lines changed: 19 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -10,22 +10,6 @@ module unix_netdb
1010
integer(kind=c_int), parameter, public :: AF_UNIX = 1
1111
integer(kind=c_int), parameter, public :: AF_INET = 2
1212

13-
#if defined (__linux__)
14-
15-
integer(kind=c_int), parameter, public :: AF_INET6 = 10
16-
17-
integer(kind=c_int), parameter, public :: SOCK_CLOEXEC = O_CLOEXEC
18-
integer(kind=c_int), parameter, public :: SOCK_NONBLOCK = O_NONBLOCK
19-
20-
#elif defined (__FreeBSD__)
21-
22-
integer(kind=c_int), parameter, public :: AF_INET6 = 28
23-
24-
integer(kind=c_int), parameter, public :: SOCK_CLOEXEC = int(z'10000000')
25-
integer(kind=c_int), parameter, public :: SOCK_NONBLOCK = int(z'20000000')
26-
27-
#endif
28-
2913
integer(kind=c_int), parameter, public :: SOCK_STREAM = 1
3014
integer(kind=c_int), parameter, public :: SOCK_DGRAM = 2
3115
integer(kind=c_int), parameter, public :: SOCK_RAW = 3
@@ -45,11 +29,16 @@ module unix_netdb
4529

4630
#if defined (__linux__)
4731

32+
integer(kind=c_int), parameter, public :: AF_INET6 = 10
33+
34+
integer(kind=c_int), parameter, public :: SOCK_CLOEXEC = O_CLOEXEC
35+
integer(kind=c_int), parameter, public :: SOCK_NONBLOCK = O_NONBLOCK
36+
4837
integer(kind=c_int), parameter, public :: c_sa_family_t = c_signed_char
4938

5039
type, bind(c), public :: c_sockaddr
51-
integer(kind=c_sa_family_t) :: sa_family = 0_c_sa_family_t
52-
character(kind=c_char) :: sa_data(14) = c_null_char
40+
integer(kind=c_sa_family_t) :: sa_family = 0_c_sa_family_t
41+
character(kind=c_char) :: sa_data(0:13) = c_null_char
5342
end type c_sockaddr
5443

5544
type, bind(c), public :: c_addrinfo
@@ -71,10 +60,15 @@ module unix_netdb
7160

7261
#elif defined (__FreeBSD__)
7362

63+
integer(kind=c_int), parameter, public :: AF_INET6 = 28
64+
65+
integer(kind=c_int), parameter, public :: SOCK_CLOEXEC = int(z'10000000')
66+
integer(kind=c_int), parameter, public :: SOCK_NONBLOCK = int(z'20000000')
67+
7468
type, bind(c), public :: c_sockaddr
75-
character(kind=c_char) :: sa_len = c_null_char
76-
integer(kind=c_int) :: sa_family = 0
77-
character(kind=c_char) :: sa_data(14) = c_null_char
69+
character(kind=c_char) :: sa_len = c_null_char
70+
integer(kind=c_int) :: sa_family = 0
71+
character(kind=c_char) :: sa_data(0:13) = c_null_char
7872
end type c_sockaddr
7973

8074
type, bind(c), public :: c_addrinfo
@@ -89,11 +83,11 @@ module unix_netdb
8983
end type c_addrinfo
9084

9185
type, bind(c), public :: c_sockaddr_in
92-
integer(kind=c_int8_t) :: sin_len = 0_c_int8_t
93-
integer(kind=c_int) :: sin_family = 0
94-
integer(kind=c_int16_t) :: sin_port = 0_c_int16_t
86+
integer(kind=c_int8_t) :: sin_len = 0_c_int8_t
87+
integer(kind=c_int) :: sin_family = 0
88+
integer(kind=c_int16_t) :: sin_port = 0_c_int16_t
9589
type(c_in_addr) :: sin_addr
96-
character(kind=c_char) :: sin_zero(8) = c_null_char
90+
character(kind=c_char) :: sin_zero(0:7) = c_null_char
9791
end type c_sockaddr_in
9892

9993
#endif

‎src/unix_pthread.F90‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,14 +4,14 @@ module unix_pthread
44
implicit none
55
private
66

7-
integer, parameter :: PTHREAD_SIZE = 8 ! 8 Bytes.
8-
97
#if defined (__linux__)
108

9+
integer, parameter :: PTHREAD_SIZE = 8 ! 8 Bytes.
1110
integer, parameter :: PTHREAD_MUTEX_SIZE = 40 ! 40 Bytes.
1211

1312
#elif defined (__FreeBSD__)
1413

14+
integer, parameter :: PTHREAD_SIZE = 8 ! 8 Bytes.
1515
integer, parameter :: PTHREAD_MUTEX_SIZE = 8 ! 8 Bytes.
1616

1717
#endif

‎src/unix_time.F90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ module unix_time
6969
integer(kind=c_int) :: tm_yday = 0 ! Day of year (0 - 365).
7070
integer(kind=c_int) :: tm_isdst = 0 ! Positive if daylight saving time is in effect.
7171
integer(kind=c_long) :: tm_gmtoff = 0_c_long ! Offset from UTC in seconds.
72-
type(c_ptr) :: tm_zone = c_null_ptr ! Abbreviation of timezone name.
72+
type(c_ptr) :: tm_zone = c_null_ptr ! Abbreviation of timezone name (const char *).
7373
end type c_tm
7474

7575
public :: c_asctime

‎src/unix_utsname.F90‎

Lines changed: 20 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -4,42 +4,44 @@ module unix_utsname
44
implicit none
55
private
66

7-
public :: c_uname
8-
97
#if defined (__linux__)
108

11-
integer(kind=c_int), parameter :: UTS_LEN = 65
9+
integer(kind=c_int), parameter, public :: SYS_NMLN = 65
1210

1311
type, bind(c), public :: c_utsname
14-
character(kind=c_char) :: sysname(UTS_LEN) = ' '
15-
character(kind=c_char) :: nodename(UTS_LEN) = ' '
16-
character(kind=c_char) :: release(UTS_LEN) = ' '
17-
character(kind=c_char) :: version(UTS_LEN) = ' '
18-
character(kind=c_char) :: machine(UTS_LEN) = ' '
19-
character(kind=c_char) :: domainname(UTS_LEN) = ' '
12+
character(kind=c_char) :: sysname(0:SYS_NMLN - 1) = c_null_char
13+
character(kind=c_char) :: nodename(0:SYS_NMLN - 1) = c_null_char
14+
character(kind=c_char) :: release(0:SYS_NMLN - 1) = c_null_char
15+
character(kind=c_char) :: version(0:SYS_NMLN - 1) = c_null_char
16+
character(kind=c_char) :: machine(0:SYS_NMLN - 1) = c_null_char
17+
character(kind=c_char) :: domainname(0:SYS_NMLN - 1) = c_null_char
2018
end type c_utsname
2119

2220
#elif defined (__FreeBSD__)
2321

24-
integer(kind=c_int), parameter :: SYS_NMLN = 32
22+
integer(kind=c_int), parameter, public :: SYS_NMLN = 256
2523

2624
type, bind(c), public :: c_utsname
27-
character(kind=c_char) :: sysname(SYS_NMLN) = ' '
28-
character(kind=c_char) :: nodename(SYS_NMLN) = ' '
29-
character(kind=c_char) :: release(SYS_NMLN) = ' '
30-
character(kind=c_char) :: version(SYS_NMLN) = ' '
31-
character(kind=c_char) :: machine(SYS_NMLN) = ' '
25+
character(kind=c_char) :: sysname(0:SYS_NMLN - 1) = c_null_char
26+
character(kind=c_char) :: nodename(0:SYS_NMLN - 1) = c_null_char
27+
character(kind=c_char) :: release(0:SYS_NMLN - 1) = c_null_char
28+
character(kind=c_char) :: version(0:SYS_NMLN - 1) = c_null_char
29+
character(kind=c_char) :: machine(0:SYS_NMLN - 1) = c_null_char
3230
end type c_utsname
3331

3432
#endif
3533

34+
public :: c_uname
35+
3636
interface
3737
! int uname(struct utsname *name)
38-
function c_uname(name) bind(c, name='uname')
38+
function c_uname(name) bind(c, name='c_uname')
39+
!! Calls wrapper `c_uname()` in `unix_macro.c`, as it is an inline
40+
!! function on FreeBSD, alternatively to callling `__xuname()`.
3941
import :: c_int, c_utsname
4042
implicit none
41-
type(c_utsname), intent(out) :: name
42-
integer(kind=c_int) :: c_uname
43+
type(c_utsname), intent(inout) :: name
44+
integer(kind=c_int) :: c_uname
4345
end function c_uname
4446
end interface
4547
end module unix_utsname

0 commit comments

Comments
 (0)