X-Git-Url: http://git.sourceforge.jp/view?a=blobdiff_plain;f=libgfortran%2Fruntime%2Ferror.c;h=cb064297c964d29277639ade88065a81cb68aa41;hb=7f934e3434f708c56050f1fbfbb4096f9b64edc5;hp=f0a4ff2291dc6476ba8f977de6bf75624de6f7ea;hpb=d5bf8d02e7b67de803855bed4366a15a026b380a;p=pf3gnuchains%2Fgcc-fork.git diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index f0a4ff2291d..cb064297c96 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -1,31 +1,27 @@ -/* Copyright (C) 2002, 2003, 2005, 2006, 2007 Free Software Foundation, Inc. +/* Copyright (C) 2002, 2003, 2005, 2006, 2007, 2009, 2010, 2011 + Free Software Foundation, Inc. Contributed by Andy Vaught -This file is part of the GNU Fortran 95 runtime library (libgfortran). +This file is part of the GNU Fortran runtime library (libgfortran). 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) +the Free Software Foundation; either version 3, or (at your option) any later version. -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 libgfortran; see the file COPYING. If not, write to -the Free Software Foundation, 51 Franklin Street, Fifth Floor, -Boston, MA 02110-1301, USA. */ +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +. */ #include "libgfortran.h" @@ -62,44 +58,32 @@ Boston, MA 02110-1301, USA. */ #endif -/* sys_exit()-- Terminate the program with an exit code. */ +/* Termination of a program: F2008 2.3.5 talks about "normal + termination" and "error termination". Normal termination occurs as + a result of e.g. executing the end program statement, and executing + the STOP statement. It includes the effect of the C exit() + function. -void -sys_exit (int code) -{ - /* Show error backtrace if possible. */ - if (code != 0 && code != 4 - && (options.backtrace == 1 - || (options.backtrace == -1 && compile_options.backtrace == 1))) - show_backtrace (); - - /* Dump core if requested. */ - if (code != 0 - && (options.dump_core == 1 - || (options.dump_core == -1 && compile_options.dump_core == 1))) - { -#if defined(HAVE_GETRLIMIT) && defined(RLIMIT_CORE) - /* Warn if a core file cannot be produced because - of core size limit. */ + Error termination is initiated when the ERROR STOP statement is + executed, when ALLOCATE/DEALLOCATE fails without STAT= being + specified, when some of the co-array synchronization statements + fail without STAT= being specified, and some I/O errors if + ERR/IOSTAT/END/EOR is not present, and finally EXECUTE_COMMAND_LINE + failure without CMDSTAT=. - struct rlimit core_limit; - - if (getrlimit (RLIMIT_CORE, &core_limit) == 0 && core_limit.rlim_cur == 0) - st_printf ("** Warning: a core dump was requested, but the core size" - "limit\n** is currently zero.\n\n"); -#endif - - -#if defined(HAVE_KILL) && defined(HAVE_GETPID) && defined(SIGQUIT) - kill (getpid (), SIGQUIT); -#else - st_printf ("Core dump not possible, sorry."); -#endif - } + 2.3.5 also explains how co-images synchronize during termination. - exit (code); -} + In libgfortran we have two ways of ending a program. exit(code) is + a normal exit; calling exit() also causes open units to be + closed. No backtrace or core dump is needed here. When something + goes wrong, we have sys_abort() which tries to print the backtrace + if -fbacktrace is enabled, and then dumps core; whether a core file + is generated is system dependent. When aborting, we don't flush and + close open units, as program memory might be corrupted and we'd + rather risk losing dirty data in the buffers rather than corrupting + files on disk. +*/ /* Error conditions. The tricky part here is printing a message when * it is the I/O subsystem that is severely wounded. Our goal is to @@ -111,52 +95,96 @@ sys_exit (int code) * 1 Terminated because of operating system error. * 2 Error in the runtime library * 3 Internal error in runtime library - * 4 Error during error processing (very bad) * * Other error returns are reserved for the STOP statement with a numeric code. */ -/* gfc_itoa()-- Integer to decimal conversion. */ -const char * -gfc_itoa (GFC_INTEGER_LARGEST n, char *buffer, size_t len) +/* Write a null-terminated C string to standard error. This function + is async-signal-safe. */ + +ssize_t +estr_write (const char *str) { - int negative; - char *p; - GFC_UINTEGER_LARGEST t; + return write (STDERR_FILENO, str, strlen (str)); +} - assert (len >= GFC_ITOA_BUF_SIZE); - if (n == 0) - return "0"; +/* st_vprintf()-- vsnprintf-like function for error output. We use a + stack allocated buffer for formatting; since this function might be + called from within a signal handler, printing directly to stderr + with vfprintf is not safe since the stderr locking might lead to a + deadlock. */ + +#define ST_VPRINTF_SIZE 512 - negative = 0; - t = n; - if (n < 0) +int +st_vprintf (const char *format, va_list ap) +{ + int written; + char buffer[ST_VPRINTF_SIZE]; + +#ifdef HAVE_VSNPRINTF + written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap); +#else + written = vsprintf(buffer, format, ap); + + if (written >= ST_VPRINTF_SIZE - 1) { - negative = 1; - t = -n; /*must use unsigned to protect from overflow*/ + /* The error message was longer than our buffer. Ouch. Because + we may have messed up things badly, report the error and + quit. */ +#define ERROR_MESSAGE "Internal error: buffer overrun in st_vprintf()\n" + write (STDERR_FILENO, buffer, ST_VPRINTF_SIZE - 1); + write (STDERR_FILENO, ERROR_MESSAGE, strlen(ERROR_MESSAGE)); + sys_abort (); +#undef ERROR_MESSAGE + } +#endif + + written = write (STDERR_FILENO, buffer, written); + return written; +} - p = buffer + GFC_ITOA_BUF_SIZE - 1; - *p = '\0'; - while (t != 0) +int +st_printf (const char * format, ...) +{ + int written; + va_list ap; + va_start (ap, format); + written = st_vprintf (format, ap); + va_end (ap); + return written; +} + + +/* sys_abort()-- Terminate the program showing backtrace and dumping + core. */ + +void +sys_abort (void) +{ + /* If backtracing is enabled, print backtrace and disable signal + handler for ABRT. */ + if (options.backtrace == 1 + || (options.backtrace == -1 && compile_options.backtrace == 1)) { - *--p = '0' + (t % 10); - t /= 10; + show_backtrace (); +#if defined(HAVE_SIGNAL) && defined(SIGABRT) + signal (SIGABRT, SIG_DFL); +#endif } - if (negative) - *--p = '-'; - return p; + abort(); } -/* xtoa()-- Integer to hexadecimal conversion. */ +/* gfc_xtoa()-- Integer to hexadecimal conversion. */ const char * -xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) +gfc_xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) { int digit; char *p; @@ -182,13 +210,37 @@ xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len) return p; } + +/* Hopefully thread-safe wrapper for a strerror_r() style function. */ + +char * +gf_strerror (int errnum, + char * buf __attribute__((unused)), + size_t buflen __attribute__((unused))) +{ +#ifdef HAVE_STRERROR_R + return + __builtin_choose_expr (__builtin_classify_type (strerror_r (0, buf, 0)) + == 5, + /* GNU strerror_r() */ + strerror_r (errnum, buf, buflen), + /* POSIX strerror_r () */ + (strerror_r (errnum, buf, buflen), buf)); +#else + /* strerror () is not necessarily thread-safe, but should at least + be available everywhere. */ + return strerror (errnum); +#endif +} + + /* show_locus()-- Print a line number and filename describing where * something went wrong */ void show_locus (st_parameter_common *cmp) { - static char *filename; + char *filename; if (!options.locus || cmp == NULL || cmp->filename == NULL) return; @@ -196,11 +248,17 @@ show_locus (st_parameter_common *cmp) if (cmp->unit > 0) { filename = filename_from_unit (cmp->unit); + if (filename != NULL) { st_printf ("At line %d of file %s (unit = %d, file = '%s')\n", - (int) cmp->line, cmp->filename, cmp->unit, filename); - free_mem (filename); + (int) cmp->line, cmp->filename, (int) cmp->unit, filename); + free (filename); + } + else + { + st_printf ("At line %d of file %s (unit = %d)\n", + (int) cmp->line, cmp->filename, (int) cmp->unit); } return; } @@ -222,12 +280,14 @@ recursion_check (void) /* Don't even try to print something at this point */ if (magic == MAGIC) - sys_exit (4); + sys_abort (); magic = MAGIC; } +#define STRERR_MAXSZ 256 + /* os_error()-- Operating system error. We get a message from the * operating system, show it and leave. Some operating system errors * are caught and processed by the library. If not, we come here. */ @@ -235,9 +295,14 @@ recursion_check (void) void os_error (const char *message) { + char errmsg[STRERR_MAXSZ]; recursion_check (); - st_printf ("Operating system error: %s\n%s\n", get_oserror (), message); - sys_exit (1); + estr_write ("Operating system error: "); + estr_write (gf_strerror (errno, errmsg, STRERR_MAXSZ)); + estr_write ("\n"); + estr_write (message); + estr_write ("\n"); + exit (1); } iexport(os_error); @@ -251,12 +316,12 @@ runtime_error (const char *message, ...) va_list ap; recursion_check (); - st_printf ("Fortran runtime error: "); + estr_write ("Fortran runtime error: "); va_start (ap, message); st_vprintf (message, ap); va_end (ap); - st_printf ("\n"); - sys_exit (2); + estr_write ("\n"); + exit (2); } iexport(runtime_error); @@ -269,17 +334,32 @@ runtime_error_at (const char *where, const char *message, ...) va_list ap; recursion_check (); - st_printf ("%s\n", where); - st_printf ("Fortran runtime error: "); + estr_write (where); + estr_write ("\nFortran runtime error: "); va_start (ap, message); st_vprintf (message, ap); va_end (ap); - st_printf ("\n"); - sys_exit (2); + estr_write ("\n"); + exit (2); } iexport(runtime_error_at); +void +runtime_warning_at (const char *where, const char *message, ...) +{ + va_list ap; + + estr_write (where); + estr_write ("\nFortran runtime warning: "); + va_start (ap, message); + st_vprintf (message, ap); + va_end (ap); + estr_write ("\n"); +} +iexport(runtime_warning_at); + + /* void internal_error()-- These are this-can't-happen errors * that indicate something deeply wrong. */ @@ -288,7 +368,9 @@ internal_error (st_parameter_common *cmp, const char *message) { recursion_check (); show_locus (cmp); - st_printf ("Internal Error: %s\n", message); + estr_write ("Internal Error: "); + estr_write (message); + estr_write ("\n"); /* This function call is here to get the main.o object file included when linking statically. This works because error.o is supposed to @@ -296,7 +378,7 @@ internal_error (st_parameter_common *cmp, const char *message) because hopefully it doesn't happen too often). */ stupid_function_name_for_static_linking(); - sys_exit (3); + exit (3); } @@ -410,6 +492,7 @@ translate_error (int code) void generate_error (st_parameter_common *cmp, int family, const char *message) { + char errmsg[STRERR_MAXSZ]; /* If there was a previous error, don't mask it with another error message, EOF or EOR condition. */ @@ -423,7 +506,8 @@ generate_error (st_parameter_common *cmp, int family, const char *message) if (message == NULL) message = - (family == LIBERROR_OS) ? get_oserror () : translate_error (family); + (family == LIBERROR_OS) ? gf_strerror (errno, errmsg, STRERR_MAXSZ) : + translate_error (family); if (cmp->flags & IOPARM_HAS_IOMSG) cf_strcpy (cmp->iomsg, cmp->iomsg_len, message); @@ -459,11 +543,29 @@ generate_error (st_parameter_common *cmp, int family, const char *message) recursion_check (); show_locus (cmp); - st_printf ("Fortran runtime error: %s\n", message); - sys_exit (2); + estr_write ("Fortran runtime error: "); + estr_write (message); + estr_write ("\n"); + exit (2); } iexport(generate_error); + +/* generate_warning()-- Similar to generate_error but just give a warning. */ + +void +generate_warning (st_parameter_common *cmp, const char *message) +{ + if (message == NULL) + message = " "; + + show_locus (cmp); + estr_write ("Fortran runtime warning: "); + estr_write (message); + estr_write ("\n"); +} + + /* Whether, for a feature included in a given standard set (GFC_STD_*), we should issue an error or a warning, or be quiet. */ @@ -473,17 +575,16 @@ notification_std (int std) int warning; if (!compile_options.pedantic) - return SILENT; + return NOTIFICATION_SILENT; warning = compile_options.warn_std & std; if ((compile_options.allow_std & std) != 0 && !warning) - return SILENT; + return NOTIFICATION_SILENT; - return warning ? WARNING : ERROR; + return warning ? NOTIFICATION_WARNING : NOTIFICATION_ERROR; } - /* Possibly issue a warning/error about use of a nonstandard (or deleted) feature. An error/warning will be issued if the currently selected standard does not contain the requested bits. */ @@ -504,13 +605,17 @@ notify_std (st_parameter_common *cmp, int std, const char * message) { recursion_check (); show_locus (cmp); - st_printf ("Fortran runtime error: %s\n", message); - sys_exit (2); + estr_write ("Fortran runtime error: "); + estr_write (message); + estr_write ("\n"); + exit (2); } else { show_locus (cmp); - st_printf ("Fortran runtime warning: %s\n", message); + estr_write ("Fortran runtime warning: "); + estr_write (message); + estr_write ("\n"); } return FAILURE; }