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