diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 537415f16fe..c2218fba717 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,14 @@ +2005-01-22 David Edelsohn + + PR libgfortran/19052 + * libgfortran.h (options_t): Add stderr_unit. + * io/io.h (error_stream): Declare. + * io/open.c (new_unit): Do not terminate abnormally if opening + file preconnected to stdin, stdout, or stderr. + * io/unit.c (init_units): Initialize stderr_unit. + * io/unix.c (error_stream): New function. + * runtime/environ.c (GFORTRAN_STDERR_UNIT): New environment variable. + 2005-01-22 Thomas Koenig PR libfortran/18982 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 2975f9e73ad..694ca1d7ac5 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -395,6 +395,9 @@ internal_proto(input_stream); extern stream *output_stream (void); internal_proto(output_stream); +extern stream *error_stream (void); +internal_proto(error_stream); + extern int compare_file_filename (stream *, const char *, int); internal_proto(compare_file_filename); diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 9c23131f97e..eaeb5a298c0 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -323,9 +323,14 @@ new_unit (unit_flags * flags) internal_error ("new_unit(): Bad status"); } - /* Make sure the file isn't already open someplace else. */ + /* Make sure the file isn't already open someplace else. + Do not error if opening file preconnected to stdin, stdout, stderr. */ - if (find_file () != NULL) + u = find_file (); + if (u != NULL + && (options.stdin_unit < 0 || u->unit_number != options.stdin_unit) + && (options.stdout_unit < 0 || u->unit_number != options.stdout_unit) + && (options.stderr_unit < 0 || u->unit_number != options.stderr_unit)) { generate_error (ERROR_ALREADY_OPEN, NULL); goto cleanup; diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index bf68b7880f1..ae0771f0816 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -334,6 +334,27 @@ init_units (void) insert_unit (u); } + if (options.stderr_unit >= 0) + { /* STDERR */ + u = get_mem (sizeof (gfc_unit)); + + u->unit_number = options.stderr_unit; + u->s = error_stream (); + + u->flags.action = ACTION_WRITE; + + u->flags.access = ACCESS_SEQUENTIAL; + u->flags.form = FORM_FORMATTED; + u->flags.status = STATUS_OLD; + u->flags.blank = BLANK_ZERO; + u->flags.position = POSITION_ASIS; + + u->recl = options.default_recl; + u->endfile = AT_ENDFILE; + + insert_unit (u); + } + /* Calculate the maximum file offset in a portable manner. * max will be the largest signed number for the type gfc_offset. * diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index daa0fb11072..5dc31a513d9 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1160,7 +1160,7 @@ input_stream (void) } -/* output_stream()-- Return a stream pointer to the default input stream. +/* output_stream()-- Return a stream pointer to the default output stream. * Called on initialization. */ stream * @@ -1170,6 +1170,15 @@ output_stream (void) } +/* error_stream()-- Return a stream pointer to the default error stream. + * Called on initialization. */ + +stream * +error_stream (void) +{ + return fd_to_stream (STDERR_FILENO, PROT_WRITE); +} + /* init_error_stream()-- Return a pointer to the error stream. This * subroutine is called when the stream is needed, rather than at * initialization. We want to work even if memory has been seriously diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index ccafb7c979b..dfa2e409f4b 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -292,7 +292,7 @@ enum typedef struct { - int stdin_unit, stdout_unit, optional_plus; + int stdin_unit, stdout_unit, stderr_unit, optional_plus; int allocate_init_flag, allocate_init_value; int locus; diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c index 87fe565729d..ae82f562b75 100644 --- a/libgfortran/runtime/environ.c +++ b/libgfortran/runtime/environ.c @@ -443,6 +443,11 @@ static variable variable_table[] = { "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."},