From 99798ba40e3813d50822f00275793e2880383fc7 Mon Sep 17 00:00:00 2001 From: fxcoudert Date: Thu, 15 Mar 2007 12:39:47 +0000 Subject: [PATCH] * 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. * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@122954 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 + gcc/fortran/gfortran.h | 1 + gcc/fortran/invoke.texi | 13 +- gcc/fortran/lang.opt | 4 + gcc/fortran/options.c | 5 + gcc/fortran/trans-decl.c | 7 +- libgfortran/ChangeLog | 19 ++ libgfortran/Makefile.am | 1 + libgfortran/Makefile.in | 13 +- libgfortran/config.h.in | 33 +++- libgfortran/configure | 197 +++++++++++++++++++- libgfortran/configure.ac | 8 +- libgfortran/fmain.c | 4 + libgfortran/libgfortran.h | 14 +- libgfortran/runtime/backtrace.c | 333 ++++++++++++++++++++++++++++++++++ libgfortran/runtime/compile_options.c | 7 +- libgfortran/runtime/environ.c | 4 + libgfortran/runtime/error.c | 6 + libgfortran/runtime/main.c | 44 +++++ 19 files changed, 707 insertions(+), 16 deletions(-) create mode 100644 libgfortran/runtime/backtrace.c diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 449f9b89d04..a738975aa31 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2007-03-15 Francois-Xavier Coudert + + * 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 Paul Thomas diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 52553a43005..b806f18cea9 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 c4d09024586..ef9825cbd7e 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 b1d5f2288a7..c1697fccb10 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= Size of the smallest matrix for which matmul will use BLAS diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index e4f6092663c..96bedabffb1 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 862958a1a95..a98b11ce5dd 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 d793b727b26..70cdf75faad 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,22 @@ +2007-03-15 Francois-Xavier Coudert + + * 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 PR libgfortran/31051 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index f306cc9f706..2338b9b8c4d 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 c1ff053d0d7..8e10976943e 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 ab7a8920713..216adba6e82 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 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 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 5939bb3b8ec..3ef0bed4abf 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 declares $ac_func. + For example, HP-UX 11i 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 to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#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 8711134d480..256a631f778 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 ec621256df1..397f17bdcf5 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 80698e94422..3703949d17a 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 00000000000..3b17a3950bf --- /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 +#include + +#ifdef HAVE_STDLIB_H +#include +#endif + +#ifdef HAVE_INTTYPES_H +#include +#endif + +#ifdef HAVE_UNISTD_H +#include +#endif + +#ifdef HAVE_INTPTR_T +# define INTPTR_T intptr_t +#else +# define INTPTR_T int +#endif + +#ifdef HAVE_EXECINFO_H +#include +#endif + +#ifdef HAVE_SYS_WAIT_H +#include +#endif + +#ifdef HAVE_STRING_H +#include +#endif + +#include + +#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 06ebc4d9023..dc404da7b53 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 cc3be215c36..c9c1e27f3a2 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 afd6a217269..93b81c10721 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 cfd77f29be9..76e4aef724c 100644 --- a/libgfortran/runtime/main.c +++ b/libgfortran/runtime/main.c @@ -32,9 +32,15 @@ Boston, MA 02110-1301, USA. */ #include #include #include +#include +#include "config.h" #include "libgfortran.h" +#ifdef HAVE_UNISTD_H +#include +#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)) -- 2.11.0