aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog10
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/invoke.texi13
-rw-r--r--gcc/fortran/lang.opt4
-rw-r--r--gcc/fortran/options.c5
-rw-r--r--gcc/fortran/trans-decl.c7
-rw-r--r--libgfortran/ChangeLog19
-rw-r--r--libgfortran/Makefile.am1
-rw-r--r--libgfortran/Makefile.in13
-rw-r--r--libgfortran/config.h.in33
-rwxr-xr-xlibgfortran/configure197
-rw-r--r--libgfortran/configure.ac8
-rw-r--r--libgfortran/fmain.c4
-rw-r--r--libgfortran/libgfortran.h14
-rw-r--r--libgfortran/runtime/backtrace.c333
-rw-r--r--libgfortran/runtime/compile_options.c7
-rw-r--r--libgfortran/runtime/environ.c4
-rw-r--r--libgfortran/runtime/error.c6
-rw-r--r--libgfortran/runtime/main.c44
19 files changed, 707 insertions, 16 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 449f9b8..a738975 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2007-03-15 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ * gfortran.h (gfc_option_t): Add flag_backtrace field.
+ * lang.opt: Add -fbacktrace option.
+ * invoke.texi: Document the new option.
+ * trans-decl.c (gfc_build_builtin_function_decls): Add new
+ option to the call to set_std.
+ * options.c (gfc_init_options, gfc_handle_option): Handle the
+ new option.
+
2007-03-15 Tobias Burnus <burnus@gcc.gnu.org>
Paul Thomas <pault@gcc.gnu.org>
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 52553a4..b806f18 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1659,6 +1659,7 @@ typedef struct
int flag_f2c;
int flag_automatic;
int flag_backslash;
+ int flag_backtrace;
int flag_allow_leading_underscore;
int flag_dump_core;
int flag_external_blas;
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index c4d0902..ef9825c 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -134,8 +134,8 @@ and Warnings}.
@item Debugging Options
@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
-@gccoptlist{-fdump-parse-tree -ffpe-trap=@var{list}
--fdump-core}
+@gccoptlist{-fdump-parse-tree -ffpe-trap=@var{list} @gol
+-fdump-core -fbacktrace}
@item Directory Options
@xref{Directory Options,,Options for Directory Search}.
@@ -562,6 +562,15 @@ zero), @samp{overflow} (overflow in a floating point operation),
@samp{precision} (loss of precision during operation) and @samp{denormal}
(operation produced a denormal value).
+@cindex -fbacktrace option
+@cindex options, -fbacktrace
+@item -fbacktrace
+@cindex backtrace
+@cindex trace
+Specify that, when a runtime error is encountered, the Fortran runtime
+library should output a backtrace of the error. This option
+only has influence for compilation of the Fortran main program.
+
@cindex -fdump-core option
@cindex options, -fdump-core
@item -fdump-core
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index b1d5f22..c1697fc 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -93,6 +93,10 @@ fbackslash
Fortran
Specify that backslash in string introduces an escape character
+fbacktrace
+Fortran
+Produce a backtrace when a runtime error is encountered
+
fblas-matmul-limit=
Fortran RejectNegative Joined UInteger
-fblas-matmul-limit=<n> Size of the smallest matrix for which matmul will use BLAS
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e4f6092..96bedab 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -94,6 +94,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.flag_preprocessed = 0;
gfc_option.flag_automatic = 1;
gfc_option.flag_backslash = 1;
+ gfc_option.flag_backtrace = 0;
gfc_option.flag_allow_leading_underscore = 0;
gfc_option.flag_dump_core = 0;
gfc_option.flag_external_blas = 0;
@@ -474,6 +475,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
gfc_option.flag_backslash = value;
break;
+ case OPT_fbacktrace:
+ gfc_option.flag_backtrace = value;
+ break;
+
case OPT_fdump_core:
gfc_option.flag_dump_core = value;
break;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 862958a..a98b11c 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2378,7 +2378,8 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_set_std =
gfc_build_library_function_decl (get_identifier (PREFIX("set_std")),
void_type_node,
- 4,
+ 5,
+ gfc_int4_type_node,
gfc_int4_type_node,
gfc_int4_type_node,
gfc_int4_type_node,
@@ -3144,7 +3145,9 @@ gfc_generate_function_code (gfc_namespace * ns)
build_int_cst (gfc_int4_type_node,
pedantic),
build_int_cst (gfc_int4_type_node,
- gfc_option.flag_dump_core));
+ gfc_option.flag_dump_core),
+ build_int_cst (gfc_int4_type_node,
+ gfc_option.flag_backtrace));
gfc_add_expr_to_block (&body, tmp);
}
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index d793b72..70cdf75 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,22 @@
+2007-03-15 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ * runtime/backtrace.c: New file.
+ * runtime/environ.c (variable_table): New GFORTRAN_ERROR_BACKTRACE
+ environment variable.
+ * runtime/compile_options.c (set_std): Add new argument.
+ * runtime/main.c (store_exe_path, full_exe_path): New functions.
+ * runtime/error.c (sys_exit): Add call to show_backtrace.
+ * libgfortran.h (options_t): New backtrace field.
+ (store_exe_path, full_exe_path, show_backtrace): New prototypes.
+ * configure.ac: Add checks for execinfo.h, execvp, pipe, dup2,
+ close, fdopen, strcasestr, getrlimit, backtrace, backtrace_symbols
+ and getppid.
+ * Makefile.am: Add runtime/backtrace.c.
+ * fmain.c (main): Add call to store_exe_path.
+ * Makefile.in: Renegerate.
+ * config.h.in: Renegerate.
+ * configure: Regenerate.
+
2007-03-14 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libgfortran/31051
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index f306cc9..2338b9b 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -97,6 +97,7 @@ runtime/in_pack_generic.c \
runtime/in_unpack_generic.c
gfor_src= \
+runtime/backtrace.c \
runtime/compile_options.c \
runtime/environ.c \
runtime/error.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index c1ff053..8e10976 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -71,8 +71,8 @@ myexeclibLTLIBRARIES_INSTALL = $(INSTALL)
toolexeclibLTLIBRARIES_INSTALL = $(INSTALL)
LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES)
libgfortran_la_LIBADD =
-am__objects_1 = compile_options.lo environ.lo error.lo fpu.lo main.lo \
- memory.lo pause.lo stop.lo string.lo select.lo
+am__objects_1 = backtrace.lo compile_options.lo environ.lo error.lo \
+ fpu.lo main.lo memory.lo pause.lo stop.lo string.lo select.lo
am__objects_2 = all_l4.lo all_l8.lo all_l16.lo
am__objects_3 = any_l4.lo any_l8.lo any_l16.lo
am__objects_4 = count_4_l4.lo count_8_l4.lo count_16_l4.lo \
@@ -476,6 +476,7 @@ runtime/in_pack_generic.c \
runtime/in_unpack_generic.c
gfor_src = \
+runtime/backtrace.c \
runtime/compile_options.c \
runtime/environ.c \
runtime/error.c \
@@ -1141,6 +1142,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/any_l8.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/args.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@
@@ -1942,6 +1944,13 @@ f2c_specifics.lo: intrinsics/f2c_specifics.F90
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $<
+backtrace.lo: runtime/backtrace.c
+@am__fastdepCC_TRUE@ if $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT backtrace.lo -MD -MP -MF "$(DEPDIR)/backtrace.Tpo" -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c; \
+@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/backtrace.Tpo" "$(DEPDIR)/backtrace.Plo"; else rm -f "$(DEPDIR)/backtrace.Tpo"; exit 1; fi
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/backtrace.c' object='backtrace.lo' libtool=yes @AMDEPBACKSLASH@
+@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
+@am__fastdepCC_FALSE@ $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c
+
compile_options.lo: runtime/compile_options.c
@am__fastdepCC_TRUE@ if $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT compile_options.lo -MD -MP -MF "$(DEPDIR)/compile_options.Tpo" -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c; \
@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/compile_options.Tpo" "$(DEPDIR)/compile_options.Plo"; else rm -f "$(DEPDIR)/compile_options.Tpo"; exit 1; fi
diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index ab7a892..216adba 100644
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -81,6 +81,12 @@
/* Define to 1 if the target supports __attribute__((visibility(...))). */
#undef HAVE_ATTRIBUTE_VISIBILITY
+/* Define to 1 if you have the `backtrace' function. */
+#undef HAVE_BACKTRACE
+
+/* Define to 1 if you have the `backtrace_symbols' function. */
+#undef HAVE_BACKTRACE_SYMBOLS
+
/* Define if fpclassify is broken. */
#undef HAVE_BROKEN_FPCLASSIFY
@@ -171,6 +177,9 @@
/* libm includes clogl */
#undef HAVE_CLOGL
+/* Define to 1 if you have the `close' function. */
+#undef HAVE_CLOSE
+
/* complex.h exists */
#undef HAVE_COMPLEX_H
@@ -261,6 +270,9 @@
/* Define to 1 if you have the `ctime' function. */
#undef HAVE_CTIME
+/* Define to 1 if you have the `dup2' function. */
+#undef HAVE_DUP2
+
/* libm includes erf */
#undef HAVE_ERF
@@ -279,9 +291,15 @@
/* libm includes erfl */
#undef HAVE_ERFL
+/* Define to 1 if you have the <execinfo.h> header file. */
+#undef HAVE_EXECINFO_H
+
/* Define to 1 if you have the `execl' function. */
#undef HAVE_EXECL
+/* Define to 1 if you have the `execvp' function. */
+#undef HAVE_EXECVP
+
/* libm includes exp */
#undef HAVE_EXP
@@ -300,6 +318,9 @@
/* libm includes fabsl */
#undef HAVE_FABSL
+/* Define to 1 if you have the `fdopen' function. */
+#undef HAVE_FDOPEN
+
/* libm includes feenableexcept */
#undef HAVE_FEENABLEEXCEPT
@@ -372,15 +393,15 @@
/* libc includes getpid */
#undef HAVE_GETPID
+/* libc includes getppid */
+#undef HAVE_GETPPID
+
/* Define to 1 if you have the `getrlimit' function. */
#undef HAVE_GETRLIMIT
/* Define to 1 if you have the `getrusage' function. */
#undef HAVE_GETRUSAGE
-/* Define to 1 if you have the `gettimeofday' function. */
-#undef HAVE_GETTIMEOFDAY
-
/* libc includes getuid */
#undef HAVE_GETUID
@@ -486,6 +507,9 @@
/* Define to 1 if you have the `perror' function. */
#undef HAVE_PERROR
+/* Define to 1 if you have the `pipe' function. */
+#undef HAVE_PIPE
+
/* libm includes pow */
#undef HAVE_POW
@@ -567,6 +591,9 @@
/* Define to 1 if you have the <stdlib.h> header file. */
#undef HAVE_STDLIB_H
+/* Define to 1 if you have the `strcasestr' function. */
+#undef HAVE_STRCASESTR
+
/* Define to 1 if you have the `strerror' function. */
#undef HAVE_STRERROR
diff --git a/libgfortran/configure b/libgfortran/configure
index 5939bb3..3ef0bed 100755
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -6575,7 +6575,8 @@ done
-for ac_header in fenv.h fptrap.h float.h
+
+for ac_header in fenv.h fptrap.h float.h execinfo.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
if eval "test \"\${$as_ac_Header+set}\" = set"; then
@@ -10398,7 +10399,122 @@ done
-for ac_func in wait setmode getrlimit gettimeofday
+
+
+
+
+
+for ac_func in wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit
+do
+as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
+echo "$as_me:$LINENO: checking for $ac_func" >&5
+echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
+if eval "test \"\${$as_ac_var+set}\" = set"; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ if test x$gcc_no_link = xyes; then
+ { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define $ac_func innocuous_$ac_func
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $ac_func
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+{
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func ();
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+char (*f) () = $ac_func;
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+int
+main ()
+{
+return f != $ac_func;
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ eval "$as_ac_var=yes"
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+eval "$as_ac_var=no"
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
+echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
+if test `eval echo '${'$as_ac_var'}'` = yes; then
+ cat >>confdefs.h <<_ACEOF
+#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
+fi
+done
+
+
+# Check for glibc backtrace functions
+
+
+for ac_func in backtrace backtrace_symbols
do
as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
echo "$as_me:$LINENO: checking for $ac_func" >&5
@@ -10727,6 +10843,83 @@ _ACEOF
fi
+echo "$as_me:$LINENO: checking for getppid in -lc" >&5
+echo $ECHO_N "checking for getppid in -lc... $ECHO_C" >&6
+if test "${ac_cv_lib_c_getppid+set}" = set; then
+ echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc $LIBS"
+if test x$gcc_no_link = xyes; then
+ { { echo "$as_me:$LINENO: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&5
+echo "$as_me: error: Link tests are not allowed after GCC_NO_EXECUTABLES." >&2;}
+ { (exit 1); exit 1; }; }
+fi
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h. */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h. */
+
+/* Override any gcc2 internal prototype to avoid an error. */
+#ifdef __cplusplus
+extern "C"
+#endif
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char getppid ();
+int
+main ()
+{
+getppid ();
+ ;
+ return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+ (eval $ac_link) 2>conftest.er1
+ ac_status=$?
+ grep -v '^ *+' conftest.er1 >conftest.err
+ rm -f conftest.er1
+ cat conftest.err >&5
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); } &&
+ { ac_try='test -z "$ac_c_werror_flag"
+ || test ! -s conftest.err'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; } &&
+ { ac_try='test -s conftest$ac_exeext'
+ { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ (eval $ac_try) 2>&5
+ ac_status=$?
+ echo "$as_me:$LINENO: \$? = $ac_status" >&5
+ (exit $ac_status); }; }; then
+ ac_cv_lib_c_getppid=yes
+else
+ echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_c_getppid=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_c_getppid" >&5
+echo "${ECHO_T}$ac_cv_lib_c_getppid" >&6
+if test $ac_cv_lib_c_getppid = yes; then
+
+cat >>confdefs.h <<\_ACEOF
+#define HAVE_GETPPID 1
+_ACEOF
+
+fi
+
echo "$as_me:$LINENO: checking for getuid in -lc" >&5
echo $ECHO_N "checking for getuid in -lc... $ECHO_C" >&6
if test "${ac_cv_lib_c_getuid+set}" = set; then
diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 8711134..256a631 100644
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -164,7 +164,7 @@ AC_HEADER_TIME
AC_HAVE_HEADERS(stdlib.h stdio.h string.h stddef.h math.h unistd.h signal.h)
AC_CHECK_HEADERS(time.h sys/params.h sys/time.h sys/times.h sys/resource.h)
AC_CHECK_HEADERS(sys/types.h sys/stat.h sys/wait.h floatingpoint.h ieeefp.h)
-AC_CHECK_HEADERS(fenv.h fptrap.h float.h)
+AC_CHECK_HEADERS(fenv.h fptrap.h float.h execinfo.h)
AC_CHECK_HEADER([complex.h],[AC_DEFINE([HAVE_COMPLEX_H], [1], [complex.h exists])])
GCC_HEADER_STDINT(gstdint.h)
@@ -176,7 +176,10 @@ AC_CHECK_MEMBERS([struct stat.st_rdev])
AC_CHECK_FUNCS(getrusage times mkstemp strtof strtold snprintf ftruncate chsize)
AC_CHECK_FUNCS(chdir strerror getlogin gethostname kill link symlink perror)
AC_CHECK_FUNCS(sleep time ttyname signal alarm ctime clock access fork execl)
-AC_CHECK_FUNCS(wait setmode getrlimit gettimeofday)
+AC_CHECK_FUNCS(wait setmode execvp pipe dup2 close fdopen strcasestr getrlimit)
+
+# Check for glibc backtrace functions
+AC_CHECK_FUNCS(backtrace backtrace_symbols)
# Check for types
AC_CHECK_TYPES([intptr_t])
@@ -184,6 +187,7 @@ AC_CHECK_TYPES([intptr_t])
# Check libc for getgid, getpid, getuid
AC_CHECK_LIB([c],[getgid],[AC_DEFINE([HAVE_GETGID],[1],[libc includes getgid])])
AC_CHECK_LIB([c],[getpid],[AC_DEFINE([HAVE_GETPID],[1],[libc includes getpid])])
+AC_CHECK_LIB([c],[getppid],[AC_DEFINE([HAVE_GETPPID],[1],[libc includes getppid])])
AC_CHECK_LIB([c],[getuid],[AC_DEFINE([HAVE_GETUID],[1],[libc includes getuid])])
# Check for C99 (and other IEEE) math functions
diff --git a/libgfortran/fmain.c b/libgfortran/fmain.c
index ec62125..397f17b 100644
--- a/libgfortran/fmain.c
+++ b/libgfortran/fmain.c
@@ -10,9 +10,13 @@ void MAIN__ (void);
int
main (int argc, char *argv[])
{
+ /* Store the path of the executable file. */
+ store_exe_path (argv[0]);
+
/* Set up the runtime environment. */
set_args (argc, argv);
+
/* Call the Fortran main program. Internally this is a function
called MAIN__ */
MAIN__ ();
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 80698e9..3703949 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -361,7 +361,7 @@ typedef struct
int fpu_round, fpu_precision, fpe;
int sighup, sigint;
- int dump_core;
+ int dump_core, backtrace;
}
options_t;
@@ -378,6 +378,7 @@ typedef struct
int pedantic;
int convert;
int dump_core;
+ int backtrace;
size_t record_marker;
int max_subrecord_length;
}
@@ -550,6 +551,17 @@ export_proto(set_args);
extern void get_args (int *, char ***);
internal_proto(get_args);
+extern void store_exe_path (const char *);
+export_proto(store_exe_path);
+
+extern char * full_exe_path (void);
+internal_proto(full_exe_path);
+
+/* backtrace.c */
+
+extern void show_backtrace (void);
+internal_proto(show_backtrace);
+
/* error.c */
#define GFC_ITOA_BUF_SIZE (sizeof (GFC_INTEGER_LARGEST) * 3 + 2)
diff --git a/libgfortran/runtime/backtrace.c b/libgfortran/runtime/backtrace.c
new file mode 100644
index 0000000..3b17a39
--- /dev/null
+++ b/libgfortran/runtime/backtrace.c
@@ -0,0 +1,333 @@
+/* Copyright (C) 2006 Free Software Foundation, Inc.
+ Contributed by François-Xavier Coudert
+
+This file is part of the GNU Fortran 95 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)
+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. */
+
+
+#include "config.h"
+#include <stdio.h>
+#include <string.h>
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef HAVE_INTTYPES_H
+#include <inttypes.h>
+#endif
+
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#ifdef HAVE_INTPTR_T
+# define INTPTR_T intptr_t
+#else
+# define INTPTR_T int
+#endif
+
+#ifdef HAVE_EXECINFO_H
+#include <execinfo.h>
+#endif
+
+#ifdef HAVE_SYS_WAIT_H
+#include <sys/wait.h>
+#endif
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+
+#include <ctype.h>
+
+#include "libgfortran.h"
+
+
+
+#ifndef HAVE_STRCASESTR
+#define HAVE_STRCASESTR 1
+static char *
+strcasestr (const char *s1, const char *s2)
+{
+ const char *p = s1;
+ const size_t len = strlen (s2);
+ const char u = *s2, v = isupper((int) *s2) ? tolower((int) *s2)
+ : (islower((int) *s2) ? toupper((int) *s2)
+ : *s2);
+
+ while (1)
+ {
+ while (*p != u && *p != v && *p)
+ p++;
+ if (*p == 0)
+ return NULL;
+ if (strncasecmp (p, s2, len) == 0)
+ return (char *)p;
+ }
+}
+#endif
+
+#define CAN_FORK (defined(HAVE_FORK) && defined(HAVE_EXECVP) \
+ && defined(HAVE_WAIT))
+#define GLIBC_BACKTRACE (defined(HAVE_BACKTRACE) \
+ && defined(HAVE_BACKTRACE_SYMBOLS))
+#define CAN_PIPE (CAN_FORK && defined(HAVE_PIPE) \
+ && defined(HAVE_DUP2) && defined(HAVE_FDOPEN) \
+ && defined(HAVE_CLOSE))
+
+
+#if GLIBC_BACKTRACE
+static void
+dump_glibc_backtrace (int depth, char *str[])
+{
+ int i;
+
+ for (i = 0; i < depth; i++)
+ st_printf (" + %s\n", str[i]);
+
+ free (str);
+}
+#endif
+
+/* show_backtrace displays the backtrace, currently obtained by means of
+ the glibc backtrace* functions. */
+void
+show_backtrace (void)
+{
+#if GLIBC_BACKTRACE
+
+#define DEPTH 50
+#define BUFSIZE 1024
+
+ void *trace[DEPTH];
+ char **str;
+ int depth;
+
+ depth = backtrace (trace, DEPTH);
+ if (depth <= 0)
+ return;
+
+ str = backtrace_symbols (trace, depth);
+
+#if CAN_PIPE
+
+#ifndef STDIN_FILENO
+#define STDIN_FILENO 0
+#endif
+
+#ifndef STDOUT_FILENO
+#define STDOUT_FILENO 1
+#endif
+
+#ifndef STDERR_FILENO
+#define STDERR_FILENO 2
+#endif
+
+ /* We attempt to extract file and line information from addr2line. */
+ do
+ {
+ /* Local variables. */
+ int f[2], pid, line, i;
+ FILE *output;
+ char addr_buf[DEPTH][GFC_XTOA_BUF_SIZE], func[BUFSIZE], file[BUFSIZE];
+ char *p, *end;
+ const char *addr[DEPTH];
+
+ /* Write the list of addresses in hexadecimal format. */
+ for (i = 0; i < depth; i++)
+ addr[i] = xtoa ((GFC_UINTEGER_LARGEST) (INTPTR_T) trace[i], addr_buf[i],
+ sizeof (addr_buf[i]));
+
+ /* Don't output an error message if something goes wrong, we'll simply
+ fall back to the pstack and glibc backtraces. */
+ if (pipe (f) != 0)
+ break;
+ if ((pid = fork ()) == -1)
+ break;
+
+ if (pid == 0)
+ {
+ /* Child process. */
+#define NUM_FIXEDARGS 5
+ char *arg[DEPTH+NUM_FIXEDARGS+1];
+
+ close (f[0]);
+ close (STDIN_FILENO);
+ close (STDERR_FILENO);
+
+ if (dup2 (f[1], STDOUT_FILENO) == -1)
+ _exit (0);
+ close (f[1]);
+
+ arg[0] = (char *) "addr2line";
+ arg[1] = (char *) "-e";
+ arg[2] = full_exe_path ();
+ arg[3] = (char *) "-f";
+ arg[4] = (char *) "-s";
+ for (i = 0; i < depth; i++)
+ arg[NUM_FIXEDARGS+i] = (char *) addr[i];
+ arg[NUM_FIXEDARGS+depth] = NULL;
+ execvp (arg[0], arg);
+ _exit (0);
+#undef NUM_FIXEDARGS
+ }
+
+ /* Father process. */
+ close (f[1]);
+ wait (NULL);
+ output = fdopen (f[0], "r");
+ i = -1;
+
+ if (fgets (func, sizeof(func), output))
+ {
+ st_printf ("\nBacktrace for this error:\n");
+
+ do
+ {
+ if (! fgets (file, sizeof(file), output))
+ goto fallback;
+
+ i++;
+
+ for (p = func; *p != '\n' && *p != '\r'; p++)
+ ;
+
+ *p = '\0';
+
+ /* Try to recognize the internal libgfortran functions. */
+ if (strncasecmp (func, "*_gfortran", 10) == 0
+ || strncasecmp (func, "_gfortran", 9) == 0
+ || strcmp (func, "main") == 0 || strcmp (func, "_start") == 0)
+ continue;
+
+ if (strcasestr (str[i], "libgfortran.so") != NULL
+ || strcasestr (str[i], "libgfortran.dylib") != NULL
+ || strcasestr (str[i], "libgfortran.a") != NULL)
+ continue;
+
+ /* If we only have the address, use the glibc backtrace. */
+ if (func[0] == '?' && func[1] == '?' && file[0] == '?'
+ && file[1] == '?')
+ {
+ st_printf (" + %s\n", str[i]);
+ continue;
+ }
+
+ /* Extract the line number. */
+ for (end = NULL, p = file; *p; p++)
+ if (*p == ':')
+ end = p;
+ if (end != NULL)
+ {
+ *end = '\0';
+ line = atoi (++end);
+ }
+ else
+ line = -1;
+
+ if (strcmp (func, "MAIN__") == 0)
+ st_printf (" + in the main program\n");
+ else
+ st_printf (" + function %s (0x%s)\n", func, addr[i]);
+
+ if (line <= 0 && strcmp (file, "??") == 0)
+ continue;
+
+ if (line <= 0)
+ st_printf (" from file %s\n", file);
+ else
+ st_printf (" at line %d of file %s\n", line, file);
+ }
+ while (fgets (func, sizeof(func), output));
+
+ free (str);
+ return;
+
+fallback:
+ st_printf ("** Something went wrong while running addr2line. **\n"
+ "** Falling back to a simpler backtrace scheme. **\n");
+ }
+ }
+ while (0);
+
+#undef DEPTH
+#undef BUFSIZE
+
+#endif
+#endif
+
+#if CAN_FORK && defined(HAVE_GETPPID)
+ /* Try to call pstack. */
+ do
+ {
+ /* Local variables. */
+ int pid;
+
+ /* Don't output an error message if something goes wrong, we'll simply
+ fall back to the pstack and glibc backtraces. */
+ if ((pid = fork ()) == -1)
+ break;
+
+ if (pid == 0)
+ {
+ /* Child process. */
+#define NUM_ARGS 2
+ char *arg[NUM_ARGS+1];
+ char buf[20];
+
+ st_printf ("\nBacktrace for this error:\n");
+ arg[0] = (char *) "pstack";
+ snprintf (buf, sizeof(buf), "%d", (int) getppid ());
+ arg[1] = buf;
+ arg[2] = NULL;
+ execvp (arg[0], arg);
+#undef NUM_ARGS
+
+ /* pstack didn't work, so we fall back to dumping the glibc
+ backtrace if we can. */
+#if GLIBC_BACKTRACE
+ dump_glibc_backtrace (depth, str);
+#else
+ st_printf (" unable to produce a backtrace, sorry!\n");
+#endif
+
+ _exit (0);
+ }
+
+ /* Father process. */
+ wait (NULL);
+ return;
+ }
+ while(0);
+#endif
+
+#if GLIBC_BACKTRACE
+ /* Fallback to the glibc backtrace. */
+ st_printf ("\nBacktrace for this error:\n");
+ dump_glibc_backtrace (depth, str);
+#endif
+}
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index 06ebc4d..dc404da 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -38,18 +38,20 @@ compile_options_t compile_options;
/* Prototypes */
extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4, GFC_INTEGER_4,
- GFC_INTEGER_4);
+ GFC_INTEGER_4, GFC_INTEGER_4);
export_proto(set_std);
void
set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std,
- GFC_INTEGER_4 pedantic, GFC_INTEGER_4 dump_core)
+ GFC_INTEGER_4 pedantic, GFC_INTEGER_4 dump_core,
+ GFC_INTEGER_4 backtrace)
{
compile_options.pedantic = pedantic;
compile_options.warn_std = warn_std;
compile_options.allow_std = allow_std;
compile_options.dump_core = dump_core;
+ compile_options.backtrace = backtrace;
}
@@ -64,6 +66,7 @@ init_compile_options (void)
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
compile_options.pedantic = 0;
compile_options.dump_core = 0;
+ compile_options.backtrace = 0;
}
/* Function called by the front-end to tell us the
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index cc3be21..c9c1e27 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -542,6 +542,10 @@ static variable variable_table[] = {
init_boolean, show_boolean,
"Dump a core file (if possible) on runtime error", -1},
+ {"GFORTRAN_ERROR_BACKTRACE", -1, &options.backtrace,
+ init_boolean, show_boolean,
+ "Print out a backtrace (if possible) on runtime error", -1},
+
{NULL, 0, NULL, NULL, NULL, NULL, 0}
};
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index afd6a21..93b81c1 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -71,6 +71,12 @@ Boston, MA 02110-1301, USA. */
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
diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index cfd77f2..76e4aef 100644
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -32,9 +32,15 @@ Boston, MA 02110-1301, USA. */
#include <string.h>
#include <math.h>
#include <stddef.h>
+#include <limits.h>
+#include "config.h"
#include "libgfortran.h"
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
/* Stupid function to be sure the constructor is always linked in, even
in the case of static linking. See PR libfortran/22298 for details. */
void
@@ -92,6 +98,44 @@ get_args (int *argc, char ***argv)
}
+static const char *exe_path;
+
+/* Save the path under which the program was called, for use in the
+ backtrace routines. */
+void
+store_exe_path (const char * argv0)
+{
+#ifndef PATH_MAX
+#define PATH_MAX 1024
+#endif
+
+#ifndef DIR_SEPARATOR
+#define DIR_SEPARATOR '/'
+#endif
+
+ char buf[PATH_MAX], *cwd, *path;
+
+ if (argv0[0] == '/')
+ {
+ exe_path = argv0;
+ return;
+ }
+
+ cwd = getcwd (buf, sizeof (buf));
+
+ /* exe_path will be cwd + "/" + argv[0] + "\0" */
+ path = malloc (strlen (cwd) + 1 + strlen (argv0) + 1);
+ st_sprintf (path, "%s%c%s", cwd, DIR_SEPARATOR, argv0);
+ exe_path = path;
+}
+
+/* Return the full path of the executable. */
+char *
+full_exe_path (void)
+{
+ return (char *) exe_path;
+}
+
/* Initialize the runtime library. */
static void __attribute__((constructor))
generated by cgit v1.1 at 2024-11-05 03:26:23 +0000