gfortran.h (gfc_option_t): Add flag_backtrace field.
* 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. From-SVN: r122954
This commit is contained in:
parent
419452fe7e
commit
868d75dbdc
19 changed files with 707 additions and 16 deletions
|
@ -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>
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 \
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
197
libgfortran/configure
vendored
197
libgfortran/configure
vendored
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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__ ();
|
||||
|
|
|
@ -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)
|
||||
|
|
333
libgfortran/runtime/backtrace.c
Normal file
333
libgfortran/runtime/backtrace.c
Normal file
|
@ -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
|
||||
}
|
|
@ -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
|
||||
|
|
|
@ -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}
|
||||
};
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Add table
Reference in a new issue