|
145
|
1 /* Copyright (C) 2002-2020 Free Software Foundation, Inc.
|
|
111
|
2 Contributed by Andy Vaught
|
|
|
3
|
|
|
4 This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
5
|
|
|
6 Libgfortran is free software; you can redistribute it and/or modify
|
|
|
7 it under the terms of the GNU General Public License as published by
|
|
|
8 the Free Software Foundation; either version 3, or (at your option)
|
|
|
9 any later version.
|
|
|
10
|
|
|
11 Libgfortran is distributed in the hope that it will be useful,
|
|
|
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
14 GNU General Public License for more details.
|
|
|
15
|
|
|
16 Under Section 7 of GPL version 3, you are granted additional
|
|
|
17 permissions described in the GCC Runtime Library Exception, version
|
|
|
18 3.1, as published by the Free Software Foundation.
|
|
|
19
|
|
|
20 You should have received a copy of the GNU General Public License and
|
|
|
21 a copy of the GCC Runtime Library Exception along with this program;
|
|
|
22 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
23 <http://www.gnu.org/licenses/>. */
|
|
|
24
|
|
|
25 #include "libgfortran.h"
|
|
|
26
|
|
|
27 #include <string.h>
|
|
|
28 #include <strings.h>
|
|
|
29 #include <ctype.h>
|
|
|
30
|
|
|
31 #ifdef HAVE_UNISTD_H
|
|
|
32 #include <unistd.h>
|
|
|
33 #endif
|
|
|
34
|
|
|
35
|
|
|
36 /* Implementation of secure_getenv() for targets where it is not
|
|
|
37 provided. */
|
|
|
38
|
|
|
39 #ifdef FALLBACK_SECURE_GETENV
|
|
|
40
|
|
|
41 #if SUPPORTS_WEAKREF && defined(HAVE___SECURE_GETENV)
|
|
|
42 static char* weak_secure_getenv (const char*)
|
|
|
43 __attribute__((__weakref__("__secure_getenv")));
|
|
|
44 #endif
|
|
|
45
|
|
|
46 char *
|
|
|
47 secure_getenv (const char *name)
|
|
|
48 {
|
|
|
49 #if SUPPORTS_WEAKREF && defined(HAVE___SECURE_GETENV)
|
|
|
50 if (weak_secure_getenv)
|
|
|
51 return weak_secure_getenv (name);
|
|
|
52 #endif
|
|
|
53
|
|
|
54 if ((getuid () == geteuid ()) && (getgid () == getegid ()))
|
|
|
55 return getenv (name);
|
|
|
56 else
|
|
|
57 return NULL;
|
|
|
58 }
|
|
|
59 #endif
|
|
|
60
|
|
|
61
|
|
|
62
|
|
|
63 /* Examine the environment for controlling aspects of the program's
|
|
|
64 execution. Our philosophy here that the environment should not prevent
|
|
|
65 the program from running, so any invalid value will be ignored. */
|
|
|
66
|
|
|
67
|
|
|
68 options_t options;
|
|
|
69
|
|
|
70 typedef struct variable
|
|
|
71 {
|
|
|
72 const char *name;
|
|
|
73 int default_value;
|
|
|
74 int *var;
|
|
|
75 void (*init) (struct variable *);
|
|
|
76 }
|
|
|
77 variable;
|
|
|
78
|
|
|
79 static void init_unformatted (variable *);
|
|
|
80
|
|
|
81
|
|
|
82 /* Initialize an integer environment variable. */
|
|
|
83
|
|
|
84 static void
|
|
|
85 init_integer (variable * v)
|
|
|
86 {
|
|
|
87 char *p, *q;
|
|
|
88
|
|
|
89 p = getenv (v->name);
|
|
|
90 if (p == NULL)
|
|
|
91 return;
|
|
|
92
|
|
|
93 for (q = p; *q; q++)
|
|
|
94 if (!isdigit (*q) && (p != q || *q != '-'))
|
|
|
95 return;
|
|
|
96
|
|
|
97 *v->var = atoi (p);
|
|
|
98 }
|
|
|
99
|
|
|
100
|
|
|
101 /* Initialize a boolean environment variable. We only look at the first
|
|
|
102 letter of the value. */
|
|
|
103
|
|
|
104 static void
|
|
|
105 init_boolean (variable * v)
|
|
|
106 {
|
|
|
107 char *p;
|
|
|
108
|
|
|
109 p = getenv (v->name);
|
|
|
110 if (p == NULL)
|
|
|
111 return;
|
|
|
112
|
|
|
113 if (*p == '1' || *p == 'Y' || *p == 'y')
|
|
|
114 *v->var = 1;
|
|
|
115 else if (*p == '0' || *p == 'N' || *p == 'n')
|
|
|
116 *v->var = 0;
|
|
|
117 }
|
|
|
118
|
|
|
119
|
|
|
120 /* Initialize a list output separator. It may contain any number of spaces
|
|
|
121 and at most one comma. */
|
|
|
122
|
|
|
123 static void
|
|
|
124 init_sep (variable * v)
|
|
|
125 {
|
|
|
126 int seen_comma;
|
|
|
127 char *p;
|
|
|
128
|
|
|
129 p = getenv (v->name);
|
|
|
130 if (p == NULL)
|
|
|
131 goto set_default;
|
|
|
132
|
|
|
133 options.separator = p;
|
|
|
134 options.separator_len = strlen (p);
|
|
|
135
|
|
|
136 /* Make sure the separator is valid */
|
|
|
137
|
|
|
138 if (options.separator_len == 0)
|
|
|
139 goto set_default;
|
|
|
140 seen_comma = 0;
|
|
|
141
|
|
|
142 while (*p)
|
|
|
143 {
|
|
|
144 if (*p == ',')
|
|
|
145 {
|
|
|
146 if (seen_comma)
|
|
|
147 goto set_default;
|
|
|
148 seen_comma = 1;
|
|
|
149 p++;
|
|
|
150 continue;
|
|
|
151 }
|
|
|
152
|
|
|
153 if (*p++ != ' ')
|
|
|
154 goto set_default;
|
|
|
155 }
|
|
|
156
|
|
|
157 return;
|
|
|
158
|
|
|
159 set_default:
|
|
|
160 options.separator = " ";
|
|
|
161 options.separator_len = 1;
|
|
|
162 }
|
|
|
163
|
|
|
164
|
|
|
165 static variable variable_table[] = {
|
|
|
166
|
|
|
167 /* Unit number that will be preconnected to standard input */
|
|
|
168 { "GFORTRAN_STDIN_UNIT", GFC_STDIN_UNIT_NUMBER, &options.stdin_unit,
|
|
|
169 init_integer },
|
|
|
170
|
|
|
171 /* Unit number that will be preconnected to standard output */
|
|
|
172 { "GFORTRAN_STDOUT_UNIT", GFC_STDOUT_UNIT_NUMBER, &options.stdout_unit,
|
|
|
173 init_integer },
|
|
|
174
|
|
|
175 /* Unit number that will be preconnected to standard error */
|
|
|
176 { "GFORTRAN_STDERR_UNIT", GFC_STDERR_UNIT_NUMBER, &options.stderr_unit,
|
|
|
177 init_integer },
|
|
|
178
|
|
|
179 /* If TRUE, all output will be unbuffered */
|
|
|
180 { "GFORTRAN_UNBUFFERED_ALL", 0, &options.all_unbuffered, init_boolean },
|
|
|
181
|
|
|
182 /* If TRUE, output to preconnected units will be unbuffered */
|
|
|
183 { "GFORTRAN_UNBUFFERED_PRECONNECTED", 0, &options.unbuffered_preconnected,
|
|
|
184 init_boolean },
|
|
|
185
|
|
|
186 /* Whether to print filename and line number on runtime error */
|
|
|
187 { "GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean },
|
|
|
188
|
|
|
189 /* Print optional plus signs in numbers where permitted */
|
|
|
190 { "GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean },
|
|
|
191
|
|
|
192 /* Separator to use when writing list output */
|
|
|
193 { "GFORTRAN_LIST_SEPARATOR", 0, NULL, init_sep },
|
|
|
194
|
|
|
195 /* Set the default data conversion for unformatted I/O */
|
|
|
196 { "GFORTRAN_CONVERT_UNIT", 0, 0, init_unformatted },
|
|
|
197
|
|
|
198 /* Print out a backtrace if possible on runtime error */
|
|
|
199 { "GFORTRAN_ERROR_BACKTRACE", -1, &options.backtrace, init_boolean },
|
|
|
200
|
|
145
|
201 /* Buffer size for unformatted files. */
|
|
|
202 { "GFORTRAN_UNFORMATTED_BUFFER_SIZE", 0, &options.unformatted_buffer_size,
|
|
|
203 init_integer },
|
|
|
204
|
|
|
205 /* Buffer size for formatted files. */
|
|
|
206 { "GFORTRAN_FORMATTED_BUFFER_SIZE", 0, &options.formatted_buffer_size,
|
|
|
207 init_integer },
|
|
|
208
|
|
111
|
209 { NULL, 0, NULL, NULL }
|
|
|
210 };
|
|
|
211
|
|
|
212
|
|
|
213 /* Initialize most runtime variables from
|
|
|
214 * environment variables. */
|
|
|
215
|
|
|
216 void
|
|
|
217 init_variables (void)
|
|
|
218 {
|
|
|
219 variable *v;
|
|
|
220
|
|
|
221 for (v = variable_table; v->name; v++)
|
|
|
222 {
|
|
|
223 if (v->var)
|
|
|
224 *v->var = v->default_value;
|
|
|
225 v->init (v);
|
|
|
226 }
|
|
|
227 }
|
|
|
228
|
|
|
229
|
|
|
230 /* This is the handling of the GFORTRAN_CONVERT_UNITS environment variable.
|
|
|
231 It is called from environ.c to parse this variable, and from
|
|
|
232 open.c to determine if the user specified a default for an
|
|
|
233 unformatted file.
|
|
|
234 The syntax of the environment variable is, in bison grammar:
|
|
|
235
|
|
|
236 GFORTRAN_CONVERT_UNITS: mode | mode ';' exception ;
|
|
|
237 mode: 'native' | 'swap' | 'big_endian' | 'little_endian' ;
|
|
|
238 exception: mode ':' unit_list | unit_list ;
|
|
|
239 unit_list: unit_spec | unit_list unit_spec ;
|
|
|
240 unit_spec: INTEGER | INTEGER '-' INTEGER ;
|
|
|
241 */
|
|
|
242
|
|
|
243 /* Defines for the tokens. Other valid tokens are ',', ':', '-'. */
|
|
|
244
|
|
|
245
|
|
|
246 #define NATIVE 257
|
|
|
247 #define SWAP 258
|
|
|
248 #define BIG 259
|
|
|
249 #define LITTLE 260
|
|
|
250 /* Some space for additional tokens later. */
|
|
|
251 #define INTEGER 273
|
|
|
252 #define END (-1)
|
|
|
253 #define ILLEGAL (-2)
|
|
|
254
|
|
|
255 typedef struct
|
|
|
256 {
|
|
|
257 int unit;
|
|
|
258 unit_convert conv;
|
|
|
259 } exception_t;
|
|
|
260
|
|
|
261
|
|
|
262 static char *p; /* Main character pointer for parsing. */
|
|
|
263 static char *lastpos; /* Auxiliary pointer, for backing up. */
|
|
|
264 static int unit_num; /* The last unit number read. */
|
|
|
265 static int unit_count; /* The number of units found. */
|
|
|
266 static int do_count; /* Parsing is done twice - first to count the number
|
|
|
267 of units, then to fill in the table. This
|
|
|
268 variable controls what to do. */
|
|
|
269 static exception_t *elist; /* The list of exceptions to the default. This is
|
|
|
270 sorted according to unit number. */
|
|
|
271 static int n_elist; /* Number of exceptions to the default. */
|
|
|
272
|
|
|
273 static unit_convert endian; /* Current endianness. */
|
|
|
274
|
|
|
275 static unit_convert def; /* Default as specified (if any). */
|
|
|
276
|
|
|
277 /* Search for a unit number, using a binary search. The
|
|
|
278 first argument is the unit number to search for. The second argument
|
|
|
279 is a pointer to an index.
|
|
|
280 If the unit number is found, the function returns 1, and the index
|
|
|
281 is that of the element.
|
|
|
282 If the unit number is not found, the function returns 0, and the
|
|
|
283 index is the one where the element would be inserted. */
|
|
|
284
|
|
|
285 static int
|
|
|
286 search_unit (int unit, int *ip)
|
|
|
287 {
|
|
|
288 int low, high, mid;
|
|
|
289
|
|
|
290 if (n_elist == 0)
|
|
|
291 {
|
|
|
292 *ip = 0;
|
|
|
293 return 0;
|
|
|
294 }
|
|
|
295
|
|
|
296 low = 0;
|
|
|
297 high = n_elist - 1;
|
|
|
298
|
|
|
299 do
|
|
|
300 {
|
|
|
301 mid = (low + high) / 2;
|
|
|
302 if (unit == elist[mid].unit)
|
|
|
303 {
|
|
|
304 *ip = mid;
|
|
|
305 return 1;
|
|
|
306 }
|
|
|
307 else if (unit > elist[mid].unit)
|
|
|
308 low = mid + 1;
|
|
|
309 else
|
|
|
310 high = mid - 1;
|
|
|
311 } while (low <= high);
|
|
|
312
|
|
|
313 if (unit > elist[mid].unit)
|
|
|
314 *ip = mid + 1;
|
|
|
315 else
|
|
|
316 *ip = mid;
|
|
|
317
|
|
|
318 return 0;
|
|
|
319 }
|
|
|
320
|
|
|
321 /* This matches a keyword. If it is found, return the token supplied,
|
|
|
322 otherwise return ILLEGAL. */
|
|
|
323
|
|
|
324 static int
|
|
|
325 match_word (const char *word, int tok)
|
|
|
326 {
|
|
|
327 int res;
|
|
|
328
|
|
|
329 if (strncasecmp (p, word, strlen (word)) == 0)
|
|
|
330 {
|
|
|
331 p += strlen (word);
|
|
|
332 res = tok;
|
|
|
333 }
|
|
|
334 else
|
|
|
335 res = ILLEGAL;
|
|
|
336 return res;
|
|
|
337 }
|
|
|
338
|
|
|
339 /* Match an integer and store its value in unit_num. This only works
|
|
|
340 if p actually points to the start of an integer. The caller has
|
|
|
341 to ensure this. */
|
|
|
342
|
|
|
343 static int
|
|
|
344 match_integer (void)
|
|
|
345 {
|
|
|
346 unit_num = 0;
|
|
|
347 while (isdigit (*p))
|
|
|
348 unit_num = unit_num * 10 + (*p++ - '0');
|
|
|
349 return INTEGER;
|
|
|
350 }
|
|
|
351
|
|
|
352 /* This reads the next token from the GFORTRAN_CONVERT_UNITS variable.
|
|
|
353 Returned values are the different tokens. */
|
|
|
354
|
|
|
355 static int
|
|
|
356 next_token (void)
|
|
|
357 {
|
|
|
358 int result;
|
|
|
359
|
|
|
360 lastpos = p;
|
|
|
361 switch (*p)
|
|
|
362 {
|
|
|
363 case '\0':
|
|
|
364 result = END;
|
|
|
365 break;
|
|
|
366
|
|
|
367 case ':':
|
|
|
368 case ',':
|
|
|
369 case '-':
|
|
|
370 case ';':
|
|
|
371 result = *p;
|
|
|
372 p++;
|
|
|
373 break;
|
|
|
374
|
|
|
375 case 'b':
|
|
|
376 case 'B':
|
|
|
377 result = match_word ("big_endian", BIG);
|
|
|
378 break;
|
|
|
379
|
|
|
380 case 'l':
|
|
|
381 case 'L':
|
|
|
382 result = match_word ("little_endian", LITTLE);
|
|
|
383 break;
|
|
|
384
|
|
|
385 case 'n':
|
|
|
386 case 'N':
|
|
|
387 result = match_word ("native", NATIVE);
|
|
|
388 break;
|
|
|
389
|
|
|
390 case 's':
|
|
|
391 case 'S':
|
|
|
392 result = match_word ("swap", SWAP);
|
|
|
393 break;
|
|
|
394
|
|
|
395 case '1': case '2': case '3': case '4': case '5':
|
|
|
396 case '6': case '7': case '8': case '9':
|
|
|
397 result = match_integer ();
|
|
|
398 break;
|
|
|
399
|
|
|
400 default:
|
|
|
401 result = ILLEGAL;
|
|
|
402 break;
|
|
|
403 }
|
|
|
404 return result;
|
|
|
405 }
|
|
|
406
|
|
|
407 /* Back up the last token by setting back the character pointer. */
|
|
|
408
|
|
|
409 static void
|
|
|
410 push_token (void)
|
|
|
411 {
|
|
|
412 p = lastpos;
|
|
|
413 }
|
|
|
414
|
|
|
415 /* This is called when a unit is identified. If do_count is nonzero,
|
|
|
416 increment the number of units by one. If do_count is zero,
|
|
|
417 put the unit into the table. */
|
|
|
418
|
|
|
419 static void
|
|
|
420 mark_single (int unit)
|
|
|
421 {
|
|
|
422 int i,j;
|
|
|
423
|
|
|
424 if (do_count)
|
|
|
425 {
|
|
|
426 unit_count++;
|
|
|
427 return;
|
|
|
428 }
|
|
|
429 if (search_unit (unit, &i))
|
|
|
430 {
|
|
|
431 elist[i].conv = endian;
|
|
|
432 }
|
|
|
433 else
|
|
|
434 {
|
|
|
435 for (j=n_elist-1; j>=i; j--)
|
|
|
436 elist[j+1] = elist[j];
|
|
|
437
|
|
|
438 n_elist += 1;
|
|
|
439 elist[i].unit = unit;
|
|
|
440 elist[i].conv = endian;
|
|
|
441 }
|
|
|
442 }
|
|
|
443
|
|
|
444 /* This is called when a unit range is identified. If do_count is
|
|
|
445 nonzero, increase the number of units. If do_count is zero,
|
|
|
446 put the unit into the table. */
|
|
|
447
|
|
|
448 static void
|
|
|
449 mark_range (int unit1, int unit2)
|
|
|
450 {
|
|
|
451 int i;
|
|
|
452 if (do_count)
|
|
|
453 unit_count += abs (unit2 - unit1) + 1;
|
|
|
454 else
|
|
|
455 {
|
|
|
456 if (unit2 < unit1)
|
|
|
457 for (i=unit2; i<=unit1; i++)
|
|
|
458 mark_single (i);
|
|
|
459 else
|
|
|
460 for (i=unit1; i<=unit2; i++)
|
|
|
461 mark_single (i);
|
|
|
462 }
|
|
|
463 }
|
|
|
464
|
|
|
465 /* Parse the GFORTRAN_CONVERT_UNITS variable. This is called
|
|
|
466 twice, once to count the units and once to actually mark them in
|
|
|
467 the table. When counting, we don't check for double occurrences
|
|
|
468 of units. */
|
|
|
469
|
|
|
470 static int
|
|
|
471 do_parse (void)
|
|
|
472 {
|
|
|
473 int tok;
|
|
|
474 int unit1;
|
|
|
475 int continue_ulist;
|
|
|
476 char *start;
|
|
|
477
|
|
|
478 unit_count = 0;
|
|
|
479
|
|
|
480 start = p;
|
|
|
481
|
|
|
482 /* Parse the string. First, let's look for a default. */
|
|
|
483 tok = next_token ();
|
|
|
484 switch (tok)
|
|
|
485 {
|
|
|
486 case NATIVE:
|
|
|
487 endian = GFC_CONVERT_NATIVE;
|
|
|
488 break;
|
|
|
489
|
|
|
490 case SWAP:
|
|
|
491 endian = GFC_CONVERT_SWAP;
|
|
|
492 break;
|
|
|
493
|
|
|
494 case BIG:
|
|
|
495 endian = GFC_CONVERT_BIG;
|
|
|
496 break;
|
|
|
497
|
|
|
498 case LITTLE:
|
|
|
499 endian = GFC_CONVERT_LITTLE;
|
|
|
500 break;
|
|
|
501
|
|
|
502 case INTEGER:
|
|
|
503 /* A leading digit means that we are looking at an exception.
|
|
|
504 Reset the position to the beginning, and continue processing
|
|
|
505 at the exception list. */
|
|
|
506 p = start;
|
|
|
507 goto exceptions;
|
|
|
508 break;
|
|
|
509
|
|
|
510 case END:
|
|
|
511 goto end;
|
|
|
512 break;
|
|
|
513
|
|
|
514 default:
|
|
|
515 goto error;
|
|
|
516 break;
|
|
|
517 }
|
|
|
518
|
|
|
519 tok = next_token ();
|
|
|
520 switch (tok)
|
|
|
521 {
|
|
|
522 case ';':
|
|
|
523 def = endian;
|
|
|
524 break;
|
|
|
525
|
|
|
526 case ':':
|
|
|
527 /* This isn't a default after all. Reset the position to the
|
|
|
528 beginning, and continue processing at the exception list. */
|
|
|
529 p = start;
|
|
|
530 goto exceptions;
|
|
|
531 break;
|
|
|
532
|
|
|
533 case END:
|
|
|
534 def = endian;
|
|
|
535 goto end;
|
|
|
536 break;
|
|
|
537
|
|
|
538 default:
|
|
|
539 goto error;
|
|
|
540 break;
|
|
|
541 }
|
|
|
542
|
|
|
543 exceptions:
|
|
|
544
|
|
|
545 /* Loop over all exceptions. */
|
|
|
546 while(1)
|
|
|
547 {
|
|
|
548 tok = next_token ();
|
|
|
549 switch (tok)
|
|
|
550 {
|
|
|
551 case NATIVE:
|
|
|
552 if (next_token () != ':')
|
|
|
553 goto error;
|
|
|
554 endian = GFC_CONVERT_NATIVE;
|
|
|
555 break;
|
|
|
556
|
|
|
557 case SWAP:
|
|
|
558 if (next_token () != ':')
|
|
|
559 goto error;
|
|
|
560 endian = GFC_CONVERT_SWAP;
|
|
|
561 break;
|
|
|
562
|
|
|
563 case LITTLE:
|
|
|
564 if (next_token () != ':')
|
|
|
565 goto error;
|
|
|
566 endian = GFC_CONVERT_LITTLE;
|
|
|
567 break;
|
|
|
568
|
|
|
569 case BIG:
|
|
|
570 if (next_token () != ':')
|
|
|
571 goto error;
|
|
|
572 endian = GFC_CONVERT_BIG;
|
|
|
573 break;
|
|
|
574
|
|
|
575 case INTEGER:
|
|
|
576 push_token ();
|
|
|
577 break;
|
|
|
578
|
|
|
579 case END:
|
|
|
580 goto end;
|
|
|
581 break;
|
|
|
582
|
|
|
583 default:
|
|
|
584 goto error;
|
|
|
585 break;
|
|
|
586 }
|
|
|
587 /* We arrive here when we want to parse a list of
|
|
|
588 numbers. */
|
|
|
589 continue_ulist = 1;
|
|
|
590 do
|
|
|
591 {
|
|
|
592 tok = next_token ();
|
|
|
593 if (tok != INTEGER)
|
|
|
594 goto error;
|
|
|
595
|
|
|
596 unit1 = unit_num;
|
|
|
597 tok = next_token ();
|
|
|
598 /* The number can be followed by a - and another number,
|
|
|
599 which means that this is a unit range, a comma
|
|
|
600 or a semicolon. */
|
|
|
601 if (tok == '-')
|
|
|
602 {
|
|
|
603 if (next_token () != INTEGER)
|
|
|
604 goto error;
|
|
|
605
|
|
|
606 mark_range (unit1, unit_num);
|
|
|
607 tok = next_token ();
|
|
|
608 if (tok == END)
|
|
|
609 goto end;
|
|
|
610 else if (tok == ';')
|
|
|
611 continue_ulist = 0;
|
|
|
612 else if (tok != ',')
|
|
|
613 goto error;
|
|
|
614 }
|
|
|
615 else
|
|
|
616 {
|
|
|
617 mark_single (unit1);
|
|
|
618 switch (tok)
|
|
|
619 {
|
|
|
620 case ';':
|
|
|
621 continue_ulist = 0;
|
|
|
622 break;
|
|
|
623
|
|
|
624 case ',':
|
|
|
625 break;
|
|
|
626
|
|
|
627 case END:
|
|
|
628 goto end;
|
|
|
629 break;
|
|
|
630
|
|
|
631 default:
|
|
|
632 goto error;
|
|
|
633 }
|
|
|
634 }
|
|
|
635 } while (continue_ulist);
|
|
|
636 }
|
|
|
637 end:
|
|
|
638 return 0;
|
|
|
639 error:
|
|
|
640 def = GFC_CONVERT_NONE;
|
|
|
641 return -1;
|
|
|
642 }
|
|
|
643
|
|
|
644 void init_unformatted (variable * v)
|
|
|
645 {
|
|
|
646 char *val;
|
|
|
647 val = getenv (v->name);
|
|
|
648 def = GFC_CONVERT_NONE;
|
|
|
649 n_elist = 0;
|
|
|
650
|
|
|
651 if (val == NULL)
|
|
|
652 return;
|
|
|
653 do_count = 1;
|
|
|
654 p = val;
|
|
|
655 do_parse ();
|
|
|
656 if (do_count <= 0)
|
|
|
657 {
|
|
|
658 n_elist = 0;
|
|
|
659 elist = NULL;
|
|
|
660 }
|
|
|
661 else
|
|
|
662 {
|
|
|
663 elist = xmallocarray (unit_count, sizeof (exception_t));
|
|
|
664 do_count = 0;
|
|
|
665 p = val;
|
|
|
666 do_parse ();
|
|
|
667 }
|
|
|
668 }
|
|
|
669
|
|
|
670 /* Get the default conversion for for an unformatted unit. */
|
|
|
671
|
|
|
672 unit_convert
|
|
|
673 get_unformatted_convert (int unit)
|
|
|
674 {
|
|
|
675 int i;
|
|
|
676
|
|
|
677 if (elist == NULL)
|
|
|
678 return def;
|
|
|
679 else if (search_unit (unit, &i))
|
|
|
680 return elist[i].conv;
|
|
|
681 else
|
|
|
682 return def;
|
|
|
683 }
|
