-/* Copyright (C) 2002-2003 Free Software Foundation, Inc.
+/* Copyright (C) 2002,2003,2005 Free Software Foundation, Inc.
Contributed by Andy Vaught
-This file is part of the GNU Fortran 95 runtime library (libgfor).
+This file is part of the GNU Fortran 95 runtime library (libgfortran).
-Libgfor is free software; you can redistribute it and/or modify
+Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
-Libgfor is distributed in the hope that it will be useful,
+In addition to the permissions in the GNU General Public License, the
+Free Software Foundation gives you unlimited permission to link the
+compiled version of this file into combinations with other programs,
+and to distribute those combinations without any restriction coming
+from the use of this file. (The General Public License restrictions
+do apply in other respects; for example, they cover modification of
+the file, and distribution when not linked into a combine
+executable.)
+
+Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with libgfor; see the file COPYING. If not, write to
+along with libgfortran; see the file COPYING. If not, write to
the Free Software Foundation, 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA. */
* but other variables are checked during execution of the user's
* program. */
-options_t options;
+options_t options = { };
-extern char **environ;
typedef struct variable
{
}
-/* init_integer()-- Initialize an integer environment variable */
+/* init_integer()-- Initialize an integer environment variable. */
static void
init_integer (variable * v)
goto set_default;
for (q = p; *q; q++)
+ if (!isdigit (*q) && (p != q || *q != '-'))
+ {
+ v->bad = 1;
+ goto set_default;
+ }
+
+ *v->var = atoi (p);
+ return;
+
+ set_default:
+ *v->var = v->value;
+ return;
+}
+
+
+/* init_unsigned_integer()-- Initialize an integer environment variable
+ which has to be positive. */
+
+static void
+init_unsigned_integer (variable * v)
+{
+ char *p, *q;
+
+ p = getenv (v->name);
+ if (p == NULL)
+ goto set_default;
+
+ for (q = p; *q; q++)
if (!isdigit (*q))
{
v->bad = 1;
"Unit number that will be preconnected to standard output\n"
"(No preconnection if negative)"},
+ {"GFORTRAN_STDERR_UNIT", 0, &options.stderr_unit, init_integer,
+ show_integer,
+ "Unit number that will be preconnected to standard error\n"
+ "(No preconnection if negative)"},
+
{"GFORTRAN_USE_STDERR", 1, &options.use_stderr, init_boolean,
show_boolean,
"Sends library output to standard error instead of standard output."},
{"GFORTRAN_SHOW_LOCUS", 1, &options.locus, init_boolean, show_boolean,
"If TRUE, print filename and line number where runtime errors happen."},
-/* GFORTRAN_NAME_xx (where xx is a unit number) gives the names of files
- * preconnected to those units. */
-
-/* GFORTRAN_UNBUFFERED_xx (where xx is a unit number) gives a boolean that is used
- * to turn off buffering for that unit. */
-
{"GFORTRAN_OPTIONAL_PLUS", 0, &options.optional_plus, init_boolean, show_boolean,
"Print optional plus signs in numbers where permitted. Default FALSE."},
{"GFORTRAN_DEFAULT_RECL", DEFAULT_RECL, &options.default_recl,
- init_integer, show_integer,
+ init_unsigned_integer, show_integer,
"Default maximum record length for sequential files. Most useful for\n"
"adjusting line length of preconnected units. Default "
stringize (DEFAULT_RECL)},
return 0;
strcpy (name, "GFORTRAN_UNBUFFERED_");
- strcat (name, itoa (n));
+ strcat (name, gfc_itoa (n));
v.name = name;
v.value = 2;
}
-/* pattern_scan()-- Given an environment string, check that the name
- * has the same name as the pattern followed by an integer. On a
- * match, a pointer to the value is returned and the integer pointed
- * to by n is updated. Returns NULL on no match. */
-
-static char *
-pattern_scan (char *env, const char *pattern, int *n)
-{
- char *p;
- size_t len;
-
- len = strlen (pattern);
- if (strncasecmp (env, pattern, len) != 0)
- return NULL;
- p = env + len;
-
- if (!isdigit (*p))
- return NULL;
-
- while (isdigit (*p))
- p++;
-
- if (*p != '=')
- return NULL;
-
- *p = '\0';
- *n = atoi (env + len);
- *p++ = '=';
-
- return p;
-}
-
-
void
show_variables (void)
{
- char *p, **e;
variable *v;
int n;
st_printf ("%s\n\n", v->desc);
}
- st_printf ("\nDefault unit names (GFORTRAN_NAME_x):\n");
-
- for (e = environ; *e; e++)
- {
- p = pattern_scan (*e, "GFORTRAN_NAME_", &n);
- if (p == NULL)
- continue;
- st_printf ("GFORTRAN_NAME_%d %s\n", n, p);
- }
-
- st_printf ("\nUnit buffering overrides (GFORTRAN_UNBUFFERED_x):\n");
- for (e = environ; *e; e++)
- {
- p = pattern_scan (*e, "GFORTRAN_UNBUFFERED_", &n);
- if (p == NULL)
- continue;
-
- st_printf ("GFORTRAN_UNBUFFERED_%d = %s\n", n, p);
- }
-
/* System error codes */
st_printf ("\nRuntime error codes:");
OSDN Git Service
