]>
Commit | Line | Data |
---|---|---|
aa6fc635 JB |
1 | /* Implementation of the GETENV g77, and |
2 | GET_ENVIRONMENT_VARIABLE F2003, intrinsics. | |
a5544970 | 3 | Copyright (C) 2004-2019 Free Software Foundation, Inc. |
aa6fc635 JB |
4 | Contributed by Janne Blomqvist. |
5 | ||
6 | This file is part of the GNU Fortran 95 runtime library (libgfortran). | |
7 | ||
8 | Libgfortran is free software; you can redistribute it and/or | |
57dea9f6 | 9 | modify it under the terms of the GNU General Public |
aa6fc635 | 10 | License as published by the Free Software Foundation; either |
748086b7 | 11 | version 3 of the License, or (at your option) any later version. |
aa6fc635 JB |
12 | |
13 | Libgfortran is distributed in the hope that it will be useful, | |
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
57dea9f6 | 16 | GNU General Public License for more details. |
aa6fc635 | 17 | |
748086b7 JJ |
18 | Under Section 7 of GPL version 3, you are granted additional |
19 | permissions described in the GCC Runtime Library Exception, version | |
20 | 3.1, as published by the Free Software Foundation. | |
21 | ||
22 | You should have received a copy of the GNU General Public License and | |
23 | a copy of the GCC Runtime Library Exception along with this program; | |
24 | see the files COPYING3 and COPYING.RUNTIME respectively. If not, see | |
25 | <http://www.gnu.org/licenses/>. */ | |
aa6fc635 | 26 | |
36ae8a61 | 27 | #include "libgfortran.h" |
aa6fc635 | 28 | #include <string.h> |
aa6fc635 JB |
29 | |
30 | ||
31 | /* GETENV (NAME, VALUE), g77 intrinsic for retrieving the value of | |
7d7b8bfe RH |
32 | an environment variable. The name of the variable is specified in |
33 | NAME, and the result is stored into VALUE. */ | |
34 | ||
35 | void PREFIX(getenv) (char *, char *, gfc_charlen_type, gfc_charlen_type); | |
36 | export_proto_np(PREFIX(getenv)); | |
aa6fc635 JB |
37 | |
38 | void | |
7d7b8bfe | 39 | PREFIX(getenv) (char * name, char * value, gfc_charlen_type name_len, |
d7177ab2 | 40 | gfc_charlen_type value_len) |
aa6fc635 | 41 | { |
3869a92c | 42 | char *name_nt; |
aa6fc635 | 43 | char *res = NULL; |
aa6fc635 JB |
44 | |
45 | if (name == NULL || value == NULL) | |
46 | runtime_error ("Both arguments to getenv are mandatory."); | |
47 | ||
48 | if (value_len < 1 || name_len < 1) | |
49 | runtime_error ("Zero length string(s) passed to getenv."); | |
50 | else | |
51 | memset (value, ' ', value_len); /* Blank the string. */ | |
52 | ||
3869a92c | 53 | /* Make a null terminated copy of the string. */ |
581d2326 | 54 | name_nt = fc_strdup (name, name_len); |
aa6fc635 JB |
55 | |
56 | res = getenv(name_nt); | |
57 | ||
581d2326 JB |
58 | free (name_nt); |
59 | ||
aa6fc635 JB |
60 | /* If res is NULL, it means that the environment variable didn't |
61 | exist, so just return. */ | |
62 | if (res == NULL) | |
63 | return; | |
64 | ||
581d2326 | 65 | cf_strcpy (value, value_len, res); |
aa6fc635 JB |
66 | } |
67 | ||
68 | ||
69 | /* GET_ENVIRONMENT_VARIABLE (name, [value, length, status, trim_name]) | |
3869a92c | 70 | is a F2003 intrinsic for getting an environment variable. */ |
aa6fc635 JB |
71 | |
72 | /* Status codes specifyed by the standard. */ | |
73 | #define GFC_SUCCESS 0 | |
74 | #define GFC_VALUE_TOO_SHORT -1 | |
75 | #define GFC_NAME_DOES_NOT_EXIST 1 | |
76 | ||
77 | /* This is also specified by the standard and means that the | |
78 | processor doesn't support environment variables. At the moment, | |
79 | gfortran doesn't use it. */ | |
80 | #define GFC_NOT_SUPPORTED 2 | |
81 | ||
82 | /* Processor-specific failure code. */ | |
83 | #define GFC_FAILURE 42 | |
84 | ||
7d7b8bfe RH |
85 | extern void get_environment_variable_i4 (char *, char *, GFC_INTEGER_4 *, |
86 | GFC_INTEGER_4 *, GFC_LOGICAL_4 *, | |
87 | gfc_charlen_type, gfc_charlen_type); | |
88 | iexport_proto(get_environment_variable_i4); | |
89 | ||
aa6fc635 | 90 | void |
7d7b8bfe RH |
91 | get_environment_variable_i4 (char *name, char *value, GFC_INTEGER_4 *length, |
92 | GFC_INTEGER_4 *status, GFC_LOGICAL_4 *trim_name, | |
93 | gfc_charlen_type name_len, | |
94 | gfc_charlen_type value_len) | |
aa6fc635 | 95 | { |
f622221a JB |
96 | int stat = GFC_SUCCESS; |
97 | gfc_charlen_type res_len = 0; | |
3869a92c SK |
98 | char *name_nt; |
99 | char *res; | |
aa6fc635 JB |
100 | |
101 | if (name == NULL) | |
102 | runtime_error ("Name is required for get_environment_variable."); | |
103 | ||
104 | if (value == NULL && length == NULL && status == NULL && trim_name == NULL) | |
105 | return; | |
106 | ||
107 | if (name_len < 1) | |
108 | runtime_error ("Zero-length string passed as name to " | |
109 | "get_environment_variable."); | |
110 | ||
111 | if (value != NULL) | |
112 | { | |
113 | if (value_len < 1) | |
114 | runtime_error ("Zero-length string passed as value to " | |
115 | "get_environment_variable."); | |
116 | else | |
117 | memset (value, ' ', value_len); /* Blank the string. */ | |
118 | } | |
119 | ||
3869a92c | 120 | if ((!trim_name) || *trim_name) |
581d2326 JB |
121 | name_nt = fc_strdup (name, name_len); |
122 | else | |
123 | name_nt = fc_strdup_notrim (name, name_len); | |
aa6fc635 JB |
124 | |
125 | res = getenv(name_nt); | |
126 | ||
581d2326 JB |
127 | free (name_nt); |
128 | ||
aa6fc635 JB |
129 | if (res == NULL) |
130 | stat = GFC_NAME_DOES_NOT_EXIST; | |
131 | else | |
132 | { | |
133 | res_len = strlen(res); | |
134 | if (value != NULL) | |
135 | { | |
136 | if (value_len < res_len) | |
137 | { | |
138 | memcpy (value, res, value_len); | |
139 | stat = GFC_VALUE_TOO_SHORT; | |
140 | } | |
141 | else | |
142 | memcpy (value, res, res_len); | |
143 | } | |
144 | } | |
145 | ||
146 | if (status != NULL) | |
147 | *status = stat; | |
148 | ||
149 | if (length != NULL) | |
150 | *length = res_len; | |
151 | } | |
7d7b8bfe | 152 | iexport(get_environment_variable_i4); |
aa6fc635 JB |
153 | |
154 | ||
155 | /* INTEGER*8 wrapper for get_environment_variable. */ | |
156 | ||
7d7b8bfe RH |
157 | extern void get_environment_variable_i8 (char *, char *, GFC_INTEGER_8 *, |
158 | GFC_INTEGER_8 *, GFC_LOGICAL_8 *, | |
159 | gfc_charlen_type, gfc_charlen_type); | |
160 | export_proto(get_environment_variable_i8); | |
161 | ||
aa6fc635 | 162 | void |
7d7b8bfe RH |
163 | get_environment_variable_i8 (char *name, char *value, GFC_INTEGER_8 *length, |
164 | GFC_INTEGER_8 *status, GFC_LOGICAL_8 *trim_name, | |
165 | gfc_charlen_type name_len, | |
166 | gfc_charlen_type value_len) | |
aa6fc635 JB |
167 | { |
168 | GFC_INTEGER_4 length4, status4; | |
169 | GFC_LOGICAL_4 trim_name4; | |
170 | ||
3869a92c SK |
171 | if (trim_name) |
172 | trim_name4 = *trim_name; | |
173 | ||
7d7b8bfe | 174 | get_environment_variable_i4 (name, value, &length4, &status4, |
9d181890 TB |
175 | trim_name ? &trim_name4 : NULL, |
176 | name_len, value_len); | |
aa6fc635 JB |
177 | |
178 | if (length) | |
179 | *length = length4; | |
180 | ||
181 | if (status) | |
182 | *status = status4; | |
183 | } |