2007-07-29 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR libfortran/32858
	PR libfortran/30814
	* configure.ac:  Added checks for presence of stdio.h and
	stdarg.h.  Test presence of vsnprintf().
	* configure: Regenerated.
	* config.h.in:  Regenerated.
	* libgfortran.h:  Include <stdio.h>.  Add printf attribute to
	prototype of runtime_error.  Remove prototype for st_sprintf.
	Add prototype for st_vprintf.
	* runtime/main.c (store_exec_path):  Replace st_sprintf by sprintf.
	* runtime/error.c (st_sprintf):  Remove.
	(runtime_error):  Rewrite as a variadic function.  Call
	st_vprintf().
	* intrinsics/pack_generic.c:  Output extents of LHS and RHS for
	bounds error.
	* io/open.c (new_unit):  Replace st_sprintf by sprintf.
	* io/list_read.c (convert_integer):  Likewise.
	(parse_repeat):  Likewise.
	(read_logical):  Likewise.
	(read_character):  Likewise.
	(parse_real):  Likewise.
	(read_real):  Likewise.
	(check_type):  Likewise.
	(nml_parse_qualifyer):  Likewise.
	(nml_read_obj):  Likewise.
	(nml_get_ojb_data):  Likewise.
	* io/unix.c (init_error_stream):  Remove.
	(tempfile):  Replace st_sprintf by sprintf.
	(st_vprintf):  New function.
	(st_printf):  Rewrite to call st_vprintf.
	* io/transfer.c (require_type):  Replace st_sprintf by sprintf.
	* io/format.c (format_error):  Likewise.
	* io/write.c (nml_write_obj):  Likewise.

2007-07-29  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/32858
	PR libfortran/30814
	* gfortran.dg/pack_bounds_1.f90:  Adjust to new error message.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127049 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1954fb0..7d4be5e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2007-07-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/32858
+       PR libfortran/30814
+       * gfortran.dg/pack_bounds_1.f90:  Adjust to new error message.
+

 2007-07-29  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/31211
 2007-07-29  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/31211

diff --git a/gcc/testsuite/gfortran.dg/pack_bounds_1.f90 b/gcc/testsuite/gfortran.dg/pack_bounds_1.f90
index 94c8eb0..d1e185c 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pack_bounds_1.f90
+++ b/gcc/testsuite/gfortran.dg/pack_bounds_1.f90
@@ -1,10 +1,10 @@
 ! { dg-do run }
 ! { dg-options "-fbounds-check" }
 ! { dg-do run }
 ! { dg-options "-fbounds-check" }

-! { dg-shouldfail "Incorrect extent in return value of  PACK intrinsic" }
+! { dg-shouldfail "Incorrect extent in return value of PACK intrinsic; is 4, should be 5" }

 ! PR 30814 - a bounds error with pack was not caught.
 program main
   integer :: a(2,2), b(5)
   a = reshape((/ 1, -1, 1, -1 /), shape(a))
   b = pack(a, a /= 0)
 end program main
 ! PR 30814 - a bounds error with pack was not caught.
 program main
   integer :: a(2,2), b(5)
   a = reshape((/ 1, -1, 1, -1 /), shape(a))
   b = pack(a, a /= 0)
 end program main

-! { dg-output "Fortran runtime error: Incorrect extent in return value of PACK intrinsic" }
+! { dg-output "Fortran runtime error: Incorrect extent in return value of PACK intrinsic; is 4, should be 5" }

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 374040d..71f0f01 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,39 @@
+2007-07-29  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/32858
+       PR libfortran/30814
+       * configure.ac:  Added checks for presence of stdio.h and
+       stdarg.h.  Test presence of vsnprintf().
+       * configure: Regenerated.
+       * config.h.in:  Regenerated.
+       * libgfortran.h:  Include <stdio.h>.  Add printf attribute to
+       prototype of runtime_error.  Remove prototype for st_sprintf.
+       Add prototype for st_vprintf.
+       * runtime/main.c (store_exec_path):  Replace st_sprintf by sprintf.
+       * runtime/error.c (st_sprintf):  Remove.
+       (runtime_error):  Rewrite as a variadic function.  Call
+       st_vprintf().
+       * intrinsics/pack_generic.c:  Output extents of LHS and RHS for
+       bounds error.
+       * io/open.c (new_unit):  Replace st_sprintf by sprintf.
+       * io/list_read.c (convert_integer):  Likewise.
+       (parse_repeat):  Likewise.
+       (read_logical):  Likewise.
+       (read_character):  Likewise.
+       (parse_real):  Likewise.
+       (read_real):  Likewise.
+       (check_type):  Likewise.
+       (nml_parse_qualifyer):  Likewise.
+       (nml_read_obj):  Likewise.
+       (nml_get_ojb_data):  Likewise.
+       * io/unix.c (init_error_stream):  Remove.
+       (tempfile):  Replace st_sprintf by sprintf.
+       (st_vprintf):  New function.
+       (st_printf):  Rewrite to call st_vprintf.
+       * io/transfer.c (require_type):  Replace st_sprintf by sprintf.
+       * io/format.c (format_error):  Likewise.
+       * io/write.c (nml_write_obj):  Likewise.
+

 2007-07-27  Janne Blomqvist  <jb@gcc.gnu.org>
 
        * io/transfer.c (st_set_nml_var_dim): Use index_type instead of
 2007-07-27  Janne Blomqvist  <jb@gcc.gnu.org>
 
        * io/transfer.c (st_set_nml_var_dim): Use index_type instead of

diff --git a/libgfortran/config.h.in b/libgfortran/config.h.in
index 205aca3..0779149 100644 (file)
--- a/libgfortran/config.h.in
+++ b/libgfortran/config.h.in
@@ -270,6 +270,9 @@
 /* Define to 1 if you have the `ctime' function. */
 #undef HAVE_CTIME
 
 /* Define to 1 if you have the `ctime' function. */
 #undef HAVE_CTIME
 

+/* Define to 1 if you have the <dlfcn.h> header file. */
+#undef HAVE_DLFCN_H
+

 /* Define to 1 if you have the `dup2' function. */
 #undef HAVE_DUP2
 
 /* Define to 1 if you have the `dup2' function. */
 #undef HAVE_DUP2
 


@@ -594,9 +597,15 @@
 /* Define to 1 if you have the `stat' function. */
 #undef HAVE_STAT
 
 /* Define to 1 if you have the `stat' function. */
 #undef HAVE_STAT
 

+/* Define to 1 if you have the <stdarg.h> header file. */
+#undef HAVE_STDARG_H
+

 /* Define to 1 if you have the <stdint.h> header file. */
 #undef HAVE_STDINT_H
 
 /* Define to 1 if you have the <stdint.h> header file. */
 #undef HAVE_STDINT_H
 

+/* Define to 1 if you have the <stdio.h> header file. */
+#undef HAVE_STDIO_H
+

 /* Define to 1 if you have the <stdlib.h> header file. */
 #undef HAVE_STDLIB_H
 
 /* Define to 1 if you have the <stdlib.h> header file. */
 #undef HAVE_STDLIB_H
 


@@ -696,6 +705,9 @@
 /* Define if target can unlink open files. */
 #undef HAVE_UNLINK_OPEN_FILE
 
 /* Define if target can unlink open files. */
 #undef HAVE_UNLINK_OPEN_FILE
 

+/* Define to 1 if you have the `vsnprintf' function. */
+#undef HAVE_VSNPRINTF
+

 /* Define to 1 if you have the `wait' function. */
 #undef HAVE_WAIT
 
 /* Define to 1 if you have the `wait' function. */
 #undef HAVE_WAIT
 


@@ -729,6 +741,10 @@
 /* libm includes ynl */
 #undef HAVE_YNL
 
 /* libm includes ynl */
 #undef HAVE_YNL
 

+/* Define to the sub-directory in which libtool stores uninstalled libraries.
+   */
+#undef LT_OBJDIR
+

 /* Define to the address where bug reports for this package should be sent. */
 #undef PACKAGE_BUGREPORT
 
 /* Define to the address where bug reports for this package should be sent. */
 #undef PACKAGE_BUGREPORT
 

diff --git a/libgfortran/configure b/libgfortran/configure
index ca967e4..7e568a3 100755 (executable)
--- a/libgfortran/configure
+++ b/libgfortran/configure
@@ -3359,6 +3359,7 @@ fi
 
 
 
 
 
 

+

 # Check for symbol versioning (copied from libssp).
 echo "$as_me:$LINENO: checking whether symbol versioning is supported" >&5
 echo $ECHO_N "checking whether symbol versioning is supported... $ECHO_C" >&6
 # Check for symbol versioning (copied from libssp).
 echo "$as_me:$LINENO: checking whether symbol versioning is supported" >&5
 echo $ECHO_N "checking whether symbol versioning is supported... $ECHO_C" >&6


@@ -4320,13 +4321,13 @@ if test "${lt_cv_nm_interface+set}" = set; then
 else
   lt_cv_nm_interface="BSD nm"
   echo "int some_variable = 0;" > conftest.$ac_ext
 else
   lt_cv_nm_interface="BSD nm"
   echo "int some_variable = 0;" > conftest.$ac_ext

-  (eval echo "\"\$as_me:4323: $ac_compile\"" >&5)
+  (eval echo "\"\$as_me:4324: $ac_compile\"" >&5)

   (eval "$ac_compile" 2>conftest.err)
   cat conftest.err >&5
   (eval "$ac_compile" 2>conftest.err)
   cat conftest.err >&5

-  (eval echo "\"\$as_me:4326: $NM \\\"conftest.$ac_objext\\\"\"" >&5)
+  (eval echo "\"\$as_me:4327: $NM \\\"conftest.$ac_objext\\\"\"" >&5)

   (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
   cat conftest.err >&5
   (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out)
   cat conftest.err >&5

-  (eval echo "\"\$as_me:4329: output\"" >&5)
+  (eval echo "\"\$as_me:4330: output\"" >&5)

   cat conftest.out >&5
   if $GREP 'External.*some_variable' conftest.out > /dev/null; then
     lt_cv_nm_interface="MS dumpbin"
   cat conftest.out >&5
   if $GREP 'External.*some_variable' conftest.out > /dev/null; then
     lt_cv_nm_interface="MS dumpbin"


@@ -5381,7 +5382,7 @@ ia64-*-hpux*)
   ;;
 *-*-irix6*)
   # Find out which ABI we are using.
   ;;
 *-*-irix6*)
   # Find out which ABI we are using.

-  echo '#line 5384 "configure"' > conftest.$ac_ext
+  echo '#line 5385 "configure"' > conftest.$ac_ext

   if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
   (eval $ac_compile) 2>&5
   ac_status=$?
   if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
   (eval $ac_compile) 2>&5
   ac_status=$?


@@ -6486,11 +6487,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:6489: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:6490: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>conftest.err)
    ac_status=$?
    cat conftest.err >&5
    (eval "$lt_compile" 2>conftest.err)
    ac_status=$?
    cat conftest.err >&5

-   echo "$as_me:6493: \$? = $ac_status" >&5
+   echo "$as_me:6494: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s "$ac_outfile"; then
      # The compiler can only warn and ignore the option if not recognized
      # So say no if there are warnings other than the usual output.
    if (exit $ac_status) && test -s "$ac_outfile"; then
      # The compiler can only warn and ignore the option if not recognized
      # So say no if there are warnings other than the usual output.


@@ -6808,11 +6809,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:6811: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:6812: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>conftest.err)
    ac_status=$?
    cat conftest.err >&5
    (eval "$lt_compile" 2>conftest.err)
    ac_status=$?
    cat conftest.err >&5

-   echo "$as_me:6815: \$? = $ac_status" >&5
+   echo "$as_me:6816: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s "$ac_outfile"; then
      # The compiler can only warn and ignore the option if not recognized
      # So say no if there are warnings other than the usual output.
    if (exit $ac_status) && test -s "$ac_outfile"; then
      # The compiler can only warn and ignore the option if not recognized
      # So say no if there are warnings other than the usual output.


@@ -6913,11 +6914,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:6916: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:6917: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5
    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5

-   echo "$as_me:6920: \$? = $ac_status" >&5
+   echo "$as_me:6921: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized
    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized


@@ -6968,11 +6969,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:6971: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:6972: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5
    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5

-   echo "$as_me:6975: \$? = $ac_status" >&5
+   echo "$as_me:6976: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized
    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized


@@ -9820,7 +9821,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF

-#line 9823 "configure"
+#line 9824 "configure"

 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H


@@ -9920,7 +9921,7 @@ else
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF
   lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2
   lt_status=$lt_dlunknown
   cat > conftest.$ac_ext <<_LT_EOF

-#line 9923 "configure"
+#line 9924 "configure"

 #include "confdefs.h"
 
 #if HAVE_DLFCN_H
 #include "confdefs.h"
 
 #if HAVE_DLFCN_H


@@ -10250,7 +10251,7 @@ fi
 
 
 # Provide some information about the compiler.
 
 
 # Provide some information about the compiler.

-echo "$as_me:10253:" \
+echo "$as_me:10254:" \

      "checking for Fortran compiler version" >&5
 ac_compiler=`set X $ac_compile; echo $2`
 { (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
      "checking for Fortran compiler version" >&5
 ac_compiler=`set X $ac_compile; echo $2`
 { (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5


@@ -10486,7 +10487,7 @@ fi
 
 
 # Provide some information about the compiler.
 
 
 # Provide some information about the compiler.

-echo "$as_me:10489:" \
+echo "$as_me:10490:" \

      "checking for Fortran compiler version" >&5
 ac_compiler=`set X $ac_compile; echo $2`
 { (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
      "checking for Fortran compiler version" >&5
 ac_compiler=`set X $ac_compile; echo $2`
 { (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5


@@ -11202,11 +11203,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:11205: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:11206: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>conftest.err)
    ac_status=$?
    cat conftest.err >&5
    (eval "$lt_compile" 2>conftest.err)
    ac_status=$?
    cat conftest.err >&5

-   echo "$as_me:11209: \$? = $ac_status" >&5
+   echo "$as_me:11210: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s "$ac_outfile"; then
      # The compiler can only warn and ignore the option if not recognized
      # So say no if there are warnings other than the usual output.
    if (exit $ac_status) && test -s "$ac_outfile"; then
      # The compiler can only warn and ignore the option if not recognized
      # So say no if there are warnings other than the usual output.


@@ -11301,11 +11302,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:11304: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:11305: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5
    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5

-   echo "$as_me:11308: \$? = $ac_status" >&5
+   echo "$as_me:11309: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized
    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized


@@ -11353,11 +11354,11 @@ else
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`
    -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \
    -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \
    -e 's:$: $lt_compiler_flag:'`

-   (eval echo "\"\$as_me:11356: $lt_compile\"" >&5)
+   (eval echo "\"\$as_me:11357: $lt_compile\"" >&5)

    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5
    (eval "$lt_compile" 2>out/conftest.err)
    ac_status=$?
    cat out/conftest.err >&5

-   echo "$as_me:11360: \$? = $ac_status" >&5
+   echo "$as_me:11361: \$? = $ac_status" >&5

    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized
    if (exit $ac_status) && test -s out/conftest2.$ac_objext
    then
      # The compiler can only warn and ignore the option if not recognized


@@ -14077,7 +14078,9 @@ fi
 
 
 
 
 
 

-for ac_header in stdlib.h string.h unistd.h signal.h
+
+
+for ac_header in stdio.h stdlib.h string.h unistd.h signal.h stdarg.h

 do
 as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
 if eval "test \"\${$as_ac_Header+set}\" = set"; then
 do
 as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
 if eval "test \"\${$as_ac_Header+set}\" = set"; then


@@ -18477,7 +18480,8 @@ done
 
 
 
 
 
 

-for ac_func in gettimeofday stat fstat lstat getpwuid
+
+for ac_func in gettimeofday stat fstat lstat getpwuid vsnprintf

 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5
 do
 as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
 echo "$as_me:$LINENO: checking for $ac_func" >&5

diff --git a/libgfortran/configure.ac b/libgfortran/configure.ac
index 9e1572f..0c85326 100644 (file)
--- a/libgfortran/configure.ac
+++ b/libgfortran/configure.ac
@@ -176,7 +176,7 @@ AC_TYPE_OFF_T
 # check header files
 AC_STDC_HEADERS
 AC_HEADER_TIME
 # check header files
 AC_STDC_HEADERS
 AC_HEADER_TIME

-AC_HAVE_HEADERS(stdlib.h string.h unistd.h signal.h)
+AC_HAVE_HEADERS(stdio.h stdlib.h string.h unistd.h signal.h stdarg.h)

 AC_CHECK_HEADERS(time.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 execinfo.h pwd.h)
 AC_CHECK_HEADERS(time.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 execinfo.h pwd.h)


@@ -192,7 +192,7 @@ 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 execvp pipe dup2 close fdopen strcasestr getrlimit)
 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 execvp pipe dup2 close fdopen strcasestr getrlimit)

-AC_CHECK_FUNCS(gettimeofday stat fstat lstat getpwuid)
+AC_CHECK_FUNCS(gettimeofday stat fstat lstat getpwuid vsnprintf)

 
 # Check for glibc backtrace functions
 AC_CHECK_FUNCS(backtrace backtrace_symbols)
 
 # Check for glibc backtrace functions
 AC_CHECK_FUNCS(backtrace backtrace_symbols)

diff --git a/libgfortran/intrinsics/pack_generic.c b/libgfortran/intrinsics/pack_generic.c
index 104c59f..a1998ad 100644 (file)
--- a/libgfortran/intrinsics/pack_generic.c
+++ b/libgfortran/intrinsics/pack_generic.c
@@ -217,9 +217,13 @@ pack_internal (gfc_array_char *ret, const gfc_array_char *array,
       else 
        {
          /* We come here because of range checking.  */
       else 
        {
          /* We come here because of range checking.  */

-         if (total != ret->dim[0].ubound + 1 - ret->dim[0].lbound)
-           runtime_error ("Incorrect extent in return value of"
-                          " PACK intrinsic");
+         index_type ret_extent;
+
+         ret_extent = ret->dim[0].ubound + 1 - ret->dim[0].lbound;
+         if (total != ret_extent)
+           runtime_error ("Incorrect extent in return value of PACK intrinsic;"
+                          " is %ld, should be %ld", (long int) total,
+                          (long int) ret_extent);

        }
     }
 
        }
     }
 

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 36ab89b..c8cd2a7 100644 (file)
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -915,7 +915,7 @@ format_error (st_parameter_dt *dtp, const fnode *f, const char *message)
   if (f != NULL)
     fmt->format_string = f->source;
 
   if (f != NULL)
     fmt->format_string = f->source;
 

-  st_sprintf (buffer, "%s\n", message);
+  sprintf (buffer, "%s\n", message);

 
   j = fmt->format_string - dtp->format;
 
 
   j = fmt->format_string - dtp->format;
 

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index b06b1ca..41d4a60 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -464,8 +464,8 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
       if (dtp->u.p.repeat_count == 0)
        {
 
       if (dtp->u.p.repeat_count == 0)
        {

-         st_sprintf (message, "Zero repeat count in item %d of list input",
-                     dtp->u.p.item_count);
+         sprintf (message, "Zero repeat count in item %d of list input",
+                  dtp->u.p.item_count);

 
          generate_error (&dtp->common, ERROR_READ_VALUE, message);
          m = 1;
 
          generate_error (&dtp->common, ERROR_READ_VALUE, message);
          m = 1;


@@ -477,11 +477,11 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
  overflow:
   if (length == -1)
 
  overflow:
   if (length == -1)

-    st_sprintf (message, "Repeat count overflow in item %d of list input",
-               dtp->u.p.item_count);
+    sprintf (message, "Repeat count overflow in item %d of list input",
+            dtp->u.p.item_count);

   else
   else

-    st_sprintf (message, "Integer overflow while reading item %d",
-               dtp->u.p.item_count);
+    sprintf (message, "Integer overflow while reading item %d",
+            dtp->u.p.item_count);

 
   free_saved (dtp);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 
   free_saved (dtp);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);


@@ -527,9 +527,9 @@ parse_repeat (st_parameter_dt *dtp)
 
          if (repeat > MAX_REPEAT)
            {
 
          if (repeat > MAX_REPEAT)
            {

-             st_sprintf (message,
-                         "Repeat count overflow in item %d of list input",
-                         dtp->u.p.item_count);
+             sprintf (message,
+                      "Repeat count overflow in item %d of list input",
+                      dtp->u.p.item_count);

 
              generate_error (&dtp->common, ERROR_READ_VALUE, message);
              return 1;
 
              generate_error (&dtp->common, ERROR_READ_VALUE, message);
              return 1;


@@ -540,9 +540,9 @@ parse_repeat (st_parameter_dt *dtp)
        case '*':
          if (repeat == 0)
            {
        case '*':
          if (repeat == 0)
            {

-             st_sprintf (message,
-                         "Zero repeat count in item %d of list input",
-                         dtp->u.p.item_count);
+             sprintf (message,
+                      "Zero repeat count in item %d of list input",
+                      dtp->u.p.item_count);

 
              generate_error (&dtp->common, ERROR_READ_VALUE, message);
              return 1;
 
              generate_error (&dtp->common, ERROR_READ_VALUE, message);
              return 1;


@@ -563,8 +563,8 @@ parse_repeat (st_parameter_dt *dtp)
 
   eat_line (dtp);
   free_saved (dtp);
 
   eat_line (dtp);
   free_saved (dtp);

-  st_sprintf (message, "Bad repeat count in item %d of list input",
-             dtp->u.p.item_count);
+  sprintf (message, "Bad repeat count in item %d of list input",
+          dtp->u.p.item_count);

   generate_error (&dtp->common, ERROR_READ_VALUE, message);
   return 1;
 }
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
   return 1;
 }


@@ -708,7 +708,7 @@ read_logical (st_parameter_dt *dtp, int length)
 
   eat_line (dtp);
   free_saved (dtp);
 
   eat_line (dtp);
   free_saved (dtp);

-  st_sprintf (message, "Bad logical value while reading item %d",
+  sprintf (message, "Bad logical value while reading item %d",

              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
   return;
              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
   return;


@@ -840,7 +840,7 @@ read_integer (st_parameter_dt *dtp, int length)
   
   eat_line (dtp);
   free_saved (dtp);
   
   eat_line (dtp);
   free_saved (dtp);

-  st_sprintf (message, "Bad integer for item %d in list input",
+  sprintf (message, "Bad integer for item %d in list input",

              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 
              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 


@@ -1004,7 +1004,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
   else
     {
       free_saved (dtp);
   else
     {
       free_saved (dtp);

-      st_sprintf (message, "Invalid string input in item %d",
+      sprintf (message, "Invalid string input in item %d",

                  dtp->u.p.item_count);
       generate_error (&dtp->common, ERROR_READ_VALUE, message);
     }
                  dtp->u.p.item_count);
       generate_error (&dtp->common, ERROR_READ_VALUE, message);
     }


@@ -1123,7 +1123,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
 
   eat_line (dtp);
   free_saved (dtp);
 
   eat_line (dtp);
   free_saved (dtp);

-  st_sprintf (message, "Bad floating point number for item %d",
+  sprintf (message, "Bad floating point number for item %d",

              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 
              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 


@@ -1206,7 +1206,7 @@ eol_2:
 
   eat_line (dtp);
   free_saved (dtp);
 
   eat_line (dtp);
   free_saved (dtp);

-  st_sprintf (message, "Bad complex value in item %d of list input",
+  sprintf (message, "Bad complex value in item %d of list input",

              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 }
              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 }


@@ -1421,7 +1421,7 @@ read_real (st_parameter_dt *dtp, int length)
 
   eat_line (dtp);
   free_saved (dtp);
 
   eat_line (dtp);
   free_saved (dtp);

-  st_sprintf (message, "Bad real number in item %d of list input",
+  sprintf (message, "Bad real number in item %d of list input",

              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 }
              dtp->u.p.item_count);
   generate_error (&dtp->common, ERROR_READ_VALUE, message);
 }


@@ -1437,7 +1437,7 @@ check_type (st_parameter_dt *dtp, bt type, int len)
 
   if (dtp->u.p.saved_type != BT_NULL && dtp->u.p.saved_type != type)
     {
 
   if (dtp->u.p.saved_type != BT_NULL && dtp->u.p.saved_type != type)
     {

-      st_sprintf (message, "Read type %s where %s was expected for item %d",
+      sprintf (message, "Read type %s where %s was expected for item %d",

                  type_name (dtp->u.p.saved_type), type_name (type),
                  dtp->u.p.item_count);
 
                  type_name (dtp->u.p.saved_type), type_name (type),
                  dtp->u.p.item_count);
 


@@ -1450,7 +1450,7 @@ check_type (st_parameter_dt *dtp, bt type, int len)
 
   if (dtp->u.p.saved_length != len)
     {
 
   if (dtp->u.p.saved_length != len)
     {

-      st_sprintf (message,
+      sprintf (message,

                  "Read kind %d %s where kind %d is required for item %d",
                  dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len,
                  dtp->u.p.item_count);
                  "Read kind %d %s where kind %d is required for item %d",
                  dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len,
                  dtp->u.p.item_count);


@@ -1723,8 +1723,8 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
                  if ((c==',' && dim == rank -1)
                      || (c==')' && dim < rank -1))
                    {
                  if ((c==',' && dim == rank -1)
                      || (c==')' && dim < rank -1))
                    {

-                     st_sprintf (parse_err_msg,
-                                 "Bad number of index fields");
+                     sprintf (parse_err_msg,
+                              "Bad number of index fields");

                      goto err_ret;
                    }
                  break;
                      goto err_ret;
                    }
                  break;


@@ -1739,21 +1739,21 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
                  break;
 
                default:
                  break;
 
                default:

-                 st_sprintf (parse_err_msg, "Bad character in index");
+                 sprintf (parse_err_msg, "Bad character in index");

                  goto err_ret;
                }
 
              if ((c == ',' || c == ')') && indx == 0
                  && dtp->u.p.saved_string == 0)
                {
                  goto err_ret;
                }
 
              if ((c == ',' || c == ')') && indx == 0
                  && dtp->u.p.saved_string == 0)
                {

-                 st_sprintf (parse_err_msg, "Null index field");
+                 sprintf (parse_err_msg, "Null index field");

                  goto err_ret;
                }
 
              if ((c == ':' && indx == 1 && dtp->u.p.saved_string == 0)
                  || (indx == 2 && dtp->u.p.saved_string == 0))
                {
                  goto err_ret;
                }
 
              if ((c == ':' && indx == 1 && dtp->u.p.saved_string == 0)
                  || (indx == 2 && dtp->u.p.saved_string == 0))
                {

-                 st_sprintf(parse_err_msg, "Bad index triplet");
+                 sprintf(parse_err_msg, "Bad index triplet");

                  goto err_ret;
                }
 
                  goto err_ret;
                }
 


@@ -1769,7 +1769,7 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
              /* Now read the index.  */
              if (convert_integer (dtp, sizeof(ssize_t), neg))
                {
              /* Now read the index.  */
              if (convert_integer (dtp, sizeof(ssize_t), neg))
                {

-                 st_sprintf (parse_err_msg, "Bad integer in index");
+                 sprintf (parse_err_msg, "Bad integer in index");

                  goto err_ret;
                }
              break;
                  goto err_ret;
                }
              break;


@@ -1811,13 +1811,13 @@ nml_parse_qualifier (st_parameter_dt *dtp, descriptor_dimension *ad,
          || (ls[dim].end > (ssize_t)ad[dim].ubound)
          || (ls[dim].end < (ssize_t)ad[dim].lbound))
        {
          || (ls[dim].end > (ssize_t)ad[dim].ubound)
          || (ls[dim].end < (ssize_t)ad[dim].lbound))
        {

-         st_sprintf (parse_err_msg, "Index %d out of range", dim + 1);
+         sprintf (parse_err_msg, "Index %d out of range", dim + 1);

          goto err_ret;
        }
       if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0)
          || (ls[dim].step == 0))
        {
          goto err_ret;
        }
       if (((ls[dim].end - ls[dim].start ) * ls[dim].step < 0)
          || (ls[dim].step == 0))
        {

-         st_sprintf (parse_err_msg, "Bad range in index %d", dim + 1);
+         sprintf (parse_err_msg, "Bad range in index %d", dim + 1);

          goto err_ret;
        }
 
          goto err_ret;
        }
 


@@ -2171,7 +2171,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset,
            goto incr_idx;
 
           default:
            goto incr_idx;
 
           default:

-           st_sprintf (nml_err_msg, "Bad type for namelist object %s",
+           sprintf (nml_err_msg, "Bad type for namelist object %s",

                        nl->var_name);
            internal_error (&dtp->common, nml_err_msg);
            goto nml_err_ret;
                        nl->var_name);
            internal_error (&dtp->common, nml_err_msg);
            goto nml_err_ret;


@@ -2260,7 +2260,7 @@ incr_idx:
 
   if (dtp->u.p.repeat_count > 1)
     {
 
   if (dtp->u.p.repeat_count > 1)
     {

-       st_sprintf (nml_err_msg, "Repeat count too large for namelist object %s" ,
+       sprintf (nml_err_msg, "Repeat count too large for namelist object %s" ,

                   nl->var_name );
        goto nml_err_ret;
     }
                   nl->var_name );
        goto nml_err_ret;
     }


@@ -2310,7 +2310,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
       c = next_char (dtp);
       if (c != '?')
        {
       c = next_char (dtp);
       if (c != '?')
        {

-         st_sprintf (nml_err_msg, "namelist read: misplaced = sign");
+         sprintf (nml_err_msg, "namelist read: misplaced = sign");

          goto nml_err_ret;
        }
       nml_query (dtp, '=');
          goto nml_err_ret;
        }
       nml_query (dtp, '=');


@@ -2325,7 +2325,7 @@ nml_get_obj_data (st_parameter_dt *dtp, namelist_info **pprev_nl,
       nml_match_name (dtp, "end", 3);
       if (dtp->u.p.nml_read_error)
        {
       nml_match_name (dtp, "end", 3);
       if (dtp->u.p.nml_read_error)
        {

-         st_sprintf (nml_err_msg, "namelist not terminated with / or &end");
+         sprintf (nml_err_msg, "namelist not terminated with / or &end");

          goto nml_err_ret;
        }
     case '/':
          goto nml_err_ret;
        }
     case '/':


@@ -2384,11 +2384,11 @@ get_name:
   if (nl == NULL)
     {
       if (dtp->u.p.nml_read_error && *pprev_nl)
   if (nl == NULL)
     {
       if (dtp->u.p.nml_read_error && *pprev_nl)

-       st_sprintf (nml_err_msg, "Bad data for namelist object %s",
+       sprintf (nml_err_msg, "Bad data for namelist object %s",

                    (*pprev_nl)->var_name);
 
       else
                    (*pprev_nl)->var_name);
 
       else

-       st_sprintf (nml_err_msg, "Cannot match namelist object name %s",
+       sprintf (nml_err_msg, "Cannot match namelist object name %s",

                    dtp->u.p.saved_string);
 
       goto nml_err_ret;
                    dtp->u.p.saved_string);
 
       goto nml_err_ret;


@@ -2412,7 +2412,7 @@ get_name:
       if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
                               parse_err_msg) == FAILURE)
        {
       if (nml_parse_qualifier (dtp, nl->dim, nl->ls, nl->var_rank,
                               parse_err_msg) == FAILURE)
        {

-         st_sprintf (nml_err_msg, "%s for namelist variable %s",
+         sprintf (nml_err_msg, "%s for namelist variable %s",

                      parse_err_msg, nl->var_name);
          goto nml_err_ret;
        }
                      parse_err_msg, nl->var_name);
          goto nml_err_ret;
        }


@@ -2429,7 +2429,7 @@ get_name:
 
       if (nl->type != GFC_DTYPE_DERIVED)
        {
 
       if (nl->type != GFC_DTYPE_DERIVED)
        {

-         st_sprintf (nml_err_msg, "Attempt to get derived component for %s",
+         sprintf (nml_err_msg, "Attempt to get derived component for %s",

                      nl->var_name);
          goto nml_err_ret;
        }
                      nl->var_name);
          goto nml_err_ret;
        }


@@ -2457,7 +2457,7 @@ get_name:
 
       if (nml_parse_qualifier (dtp, chd, ind, 1, parse_err_msg) == FAILURE)
        {
 
       if (nml_parse_qualifier (dtp, chd, ind, 1, parse_err_msg) == FAILURE)
        {

-         st_sprintf (nml_err_msg, "%s for namelist variable %s",
+         sprintf (nml_err_msg, "%s for namelist variable %s",

                      parse_err_msg, nl->var_name);
          goto nml_err_ret;
        }
                      parse_err_msg, nl->var_name);
          goto nml_err_ret;
        }


@@ -2467,7 +2467,7 @@ get_name:
 
       if (ind[0].step != 1)
        {
 
       if (ind[0].step != 1)
        {

-         st_sprintf (nml_err_msg,
+         sprintf (nml_err_msg,

                      "Bad step in substring for namelist object %s",
                      nl->var_name);
          goto nml_err_ret;
                      "Bad step in substring for namelist object %s",
                      nl->var_name);
          goto nml_err_ret;


@@ -2490,7 +2490,7 @@ get_name:
 
   if (c == '(')
     {
 
   if (c == '(')
     {

-      st_sprintf (nml_err_msg, "Qualifier for a scalar or non-character"
+      sprintf (nml_err_msg, "Qualifier for a scalar or non-character"

                  " namelist object %s", nl->var_name);
       goto nml_err_ret;
     }
                  " namelist object %s", nl->var_name);
       goto nml_err_ret;
     }


@@ -2514,7 +2514,7 @@ get_name:
 
   if (c != '=')
     {
 
   if (c != '=')
     {

-      st_sprintf (nml_err_msg, "Equal sign must follow namelist object name %s",
+      sprintf (nml_err_msg, "Equal sign must follow namelist object name %s",

                  nl->var_name);
       goto nml_err_ret;
     }
                  nl->var_name);
       goto nml_err_ret;
     }

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 68be74b..67f8804 100644 (file)
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -389,19 +389,19 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
       switch (errno)
        {
        case ENOENT: 
       switch (errno)
        {
        case ENOENT: 

-         st_sprintf (msg, "File '%s' does not exist", path);
+         sprintf (msg, "File '%s' does not exist", path);

          break;
 
        case EEXIST:
          break;
 
        case EEXIST:

-         st_sprintf (msg, "File '%s' already exists", path);
+         sprintf (msg, "File '%s' already exists", path);

          break;
 
        case EACCES:
          break;
 
        case EACCES:

-         st_sprintf (msg, "Permission denied trying to open file '%s'", path);
+         sprintf (msg, "Permission denied trying to open file '%s'", path);

          break;
 
        case EISDIR:
          break;
 
        case EISDIR:

-         st_sprintf (msg, "'%s' is a directory", path);
+         sprintf (msg, "'%s' is a directory", path);

          break;
 
        default:
          break;
 
        default:

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 3feae04..04f9f73 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -852,8 +852,8 @@ require_type (st_parameter_dt *dtp, bt expected, bt actual, const fnode *f)
   if (actual == expected)
     return 0;
 
   if (actual == expected)
     return 0;
 

-  st_sprintf (buffer, "Expected %s for item %d in formatted transfer, got %s",
-             type_name (expected), dtp->u.p.item_count, type_name (actual));
+  sprintf (buffer, "Expected %s for item %d in formatted transfer, got %s",
+          type_name (expected), dtp->u.p.item_count, type_name (actual));

 
   format_error (dtp, f, buffer);
   return 1;
 
   format_error (dtp, f, buffer);
   return 1;

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 87d001e..e9ad164 100644 (file)
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -142,10 +142,6 @@ typedef struct
 }
 int_stream;
 
 }
 int_stream;
 

-extern stream *init_error_stream (unix_stream *);
-internal_proto(init_error_stream);
-
-

 /* This implementation of stream I/O is based on the paper:
  *
  *  "Exploiting the advantages of mapped files for stream I/O",
 /* This implementation of stream I/O is based on the paper:
  *
  *  "Exploiting the advantages of mapped files for stream I/O",


@@ -1155,7 +1151,7 @@ tempfile (st_parameter_open *opp)
 
   template = get_mem (strlen (tempdir) + 20);
 
 
   template = get_mem (strlen (tempdir) + 20);
 

-  st_sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);
+  sprintf (template, "%s/gfortrantmpXXXXXX", tempdir);

 
 #ifdef HAVE_MKSTEMP
 
 
 #ifdef HAVE_MKSTEMP
 


@@ -1385,122 +1381,44 @@ error_stream (void)
   return fd_to_stream (STDERR_FILENO, PROT_WRITE);
 }
 
   return fd_to_stream (STDERR_FILENO, PROT_WRITE);
 }
 

-/* init_error_stream()-- Return a pointer to the error stream.  This
- * subroutine is called when the stream is needed, rather than at
- * initialization.  We want to work even if memory has been seriously
- * corrupted. */

 
 

-stream *
-init_error_stream (unix_stream *error)
-{
-  memset (error, '\0', sizeof (*error));
+/* st_vprintf()-- vprintf function for error output.  To avoid buffer
+   overruns, we limit the length of the buffer to ST_VPRINTF_SIZE.  2k
+   is big enough to completely fill a 80x25 terminal, so it shuld be
+   OK.  We use a direct write() because it is simpler and least likely
+   to be clobbered by memory corruption.  */

 
 

-  error->fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+#define ST_VPRINTF_SIZE 2048

 
 

-  error->st.alloc_w_at = (void *) fd_alloc_w_at;
-  error->st.sfree = (void *) fd_sfree;
-
-  error->unbuffered = 1;
-  error->buffer = error->small_buffer;
+int
+st_vprintf (const char *format, va_list ap)
+{
+  static char buffer[ST_VPRINTF_SIZE];
+  int written;
+  int fd;

 
 

-  return (stream *) error;
+  fd = options.use_stderr ? STDERR_FILENO : STDOUT_FILENO;
+#ifdef HAVE_VSNPRINTF
+  written = vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
+#else
+  written = __builtin_vsnprintf(buffer, ST_VPRINTF_SIZE, format, ap);
+#endif
+  written = write (fd, buffer, written);
+  return written;

 }
 
 }
 

-/* st_printf()-- simple printf() function for streams that handles the
- * formats %d, %s and %c.  This function handles printing of error
- * messages that originate within the library itself, not from a user
- * program. */
+/* st_printf()-- printf() function for error output.  This just calls
+   st_vprintf() to do the actual work.  */

 
 int
 st_printf (const char *format, ...)
 {
 
 int
 st_printf (const char *format, ...)
 {

-  int count, total;
-  va_list arg;
-  char *p;
-  const char *q;
-  stream *s;
-  char itoa_buf[GFC_ITOA_BUF_SIZE];
-  unix_stream err_stream;
-
-  total = 0;
-  s = init_error_stream (&err_stream);
-  va_start (arg, format);
-
-  for (;;)
-    {
-      count = 0;
-
-      while (format[count] != '%' && format[count] != '\0')
-       count++;
-
-      if (count != 0)
-       {
-         p = salloc_w (s, &count);
-         memmove (p, format, count);
-         sfree (s);
-       }
-
-      total += count;
-      format += count;
-      if (*format++ == '\0')
-       break;
-
-      switch (*format)
-       {
-       case 'c':
-         count = 1;
-
-         p = salloc_w (s, &count);
-         *p = (char) va_arg (arg, int);
-
-         sfree (s);
-         break;
-
-       case 'd':
-         q = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
-         count = strlen (q);
-
-         p = salloc_w (s, &count);
-         memmove (p, q, count);
-         sfree (s);
-         break;
-
-       case 'x':
-         q = xtoa (va_arg (arg, unsigned), itoa_buf, sizeof (itoa_buf));
-         count = strlen (q);
-
-         p = salloc_w (s, &count);
-         memmove (p, q, count);
-         sfree (s);
-         break;
-
-       case 's':
-         q = va_arg (arg, char *);
-         count = strlen (q);
-
-         p = salloc_w (s, &count);
-         memmove (p, q, count);
-         sfree (s);
-         break;
-
-       case '\0':
-         return total;
-
-       default:
-         count = 2;
-         p = salloc_w (s, &count);
-         p[0] = format[-1];
-         p[1] = format[0];
-         sfree (s);
-         break;
-       }
-
-      total += count;
-      format++;
-    }
-
-  va_end (arg);
-  return total;
+  int written;
+  va_list ap;
+  va_start (ap, format);
+  written = st_vprintf(format, ap);
+  va_end (ap);
+  return written;

 }
 
 
 }
 
 

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index b4e5d3e..9509711 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1719,7 +1719,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
        {
          if (rep_ctr > 1)
            {
        {
          if (rep_ctr > 1)
            {

-             st_sprintf(rep_buff, " %d*", rep_ctr);
+             sprintf(rep_buff, " %d*", rep_ctr);

              write_character (dtp, rep_buff, strlen (rep_buff));
              dtp->u.p.no_leading_blank = 1;
            }
              write_character (dtp, rep_buff, strlen (rep_buff));
              dtp->u.p.no_leading_blank = 1;
            }


@@ -1792,7 +1792,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
                      ext_name[tot_len] = '(';
                      tot_len++;
                    }
                      ext_name[tot_len] = '(';
                      tot_len++;
                    }

-                 st_sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx);
+                 sprintf (ext_name + tot_len, "%d", (int) obj->ls[dim_i].idx);

                  tot_len += strlen (ext_name + tot_len);
                  ext_name[tot_len] = (dim_i == obj->var_rank - 1) ? ')' : ',';
                  tot_len++;
                  tot_len += strlen (ext_name + tot_len);
                  ext_name[tot_len] = (dim_i == obj->var_rank - 1) ? ')' : ',';
                  tot_len++;

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index a1efab2..33c2e2c 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -31,6 +31,7 @@ Boston, MA 02110-1301, USA.  */
 #ifndef LIBGFOR_H
 #define LIBGFOR_H
 
 #ifndef LIBGFOR_H
 #define LIBGFOR_H
 

+#include <stdio.h>

 #include <math.h>
 #include <stddef.h>
 #include <float.h>
 #include <math.h>
 #include <stddef.h>
 #include <float.h>


@@ -593,7 +594,8 @@ iexport_proto(os_error);
 extern void show_locus (st_parameter_common *);
 internal_proto(show_locus);
 
 extern void show_locus (st_parameter_common *);
 internal_proto(show_locus);
 

-extern void runtime_error (const char *) __attribute__ ((noreturn));
+extern void runtime_error (const char *, ...)
+     __attribute__ ((noreturn, format (printf, 1, 2)));

 iexport_proto(runtime_error);
 
 extern void runtime_error_at (const char *, const char *)
 iexport_proto(runtime_error);
 
 extern void runtime_error_at (const char *, const char *)


@@ -607,10 +609,6 @@ internal_proto(internal_error);
 extern const char *get_oserror (void);
 internal_proto(get_oserror);
 
 extern const char *get_oserror (void);
 internal_proto(get_oserror);
 

-extern void st_sprintf (char *, const char *, ...)
-  __attribute__ ((format (printf, 2, 3)));
-internal_proto(st_sprintf);
-

 extern const char *translate_error (int);
 internal_proto(translate_error);
 
 extern const char *translate_error (int);
 internal_proto(translate_error);
 


@@ -688,6 +686,9 @@ extern int st_printf (const char *, ...)
   __attribute__ ((format (printf, 1, 2)));
 internal_proto(st_printf);
 
   __attribute__ ((format (printf, 1, 2)));
 internal_proto(st_printf);
 

+extern int st_vprintf (const char *, va_list);
+internal_proto(st_vprintf);
+

 extern char * filename_from_unit (int);
 internal_proto(filename_from_unit);
 
 extern char * filename_from_unit (int);
 internal_proto(filename_from_unit);
 

diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 959a44b..4dda227 100644 (file)
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -185,63 +185,6 @@ xtoa (GFC_UINTEGER_LARGEST n, char *buffer, size_t len)
   return p;
 }
 
   return p;
 }
 

-
-/* st_sprintf()-- Simple sprintf() for formatting memory buffers. */
-
-void
-st_sprintf (char *buffer, const char *format, ...)
-{
-  va_list arg;
-  char c;
-  const char *p;
-  int count;
-  char itoa_buf[GFC_ITOA_BUF_SIZE];
-
-  va_start (arg, format);
-
-  for (;;)
-    {
-      c = *format++;
-      if (c != '%')
-       {
-         *buffer++ = c;
-         if (c == '\0')
-           break;
-         continue;
-       }
-
-      c = *format++;
-      switch (c)
-       {
-       case 'c':
-         *buffer++ = (char) va_arg (arg, int);
-         break;
-
-       case 'd':
-         p = gfc_itoa (va_arg (arg, int), itoa_buf, sizeof (itoa_buf));
-         count = strlen (p);
-
-         memcpy (buffer, p, count);
-         buffer += count;
-         break;
-
-       case 's':
-         p = va_arg (arg, char *);
-         count = strlen (p);
-
-         memcpy (buffer, p, count);
-         buffer += count;
-         break;
-
-       default:
-         *buffer++ = c;
-       }
-    }
-
-  va_end (arg);
-}
-
-

 /* show_locus()-- Print a line number and filename describing where
  * something went wrong */
 
 /* show_locus()-- Print a line number and filename describing where
  * something went wrong */
 


@@ -306,10 +249,16 @@ iexport(os_error);
  * invalid fortran program. */
 
 void
  * invalid fortran program. */
 
 void

-runtime_error (const char *message)
+runtime_error (const char *message, ...)

 {
 {

+  va_list ap;
+

   recursion_check ();
   recursion_check ();

-  st_printf ("Fortran runtime error: %s\n", message);
+  st_printf ("Fortran runtime error: ");
+  va_start (ap, message);
+  st_vprintf (message, ap);
+  va_end (ap);
+  st_printf ("\n");

   sys_exit (2);
 }
 iexport(runtime_error);
   sys_exit (2);
 }
 iexport(runtime_error);

diff --git a/libgfortran/runtime/main.c b/libgfortran/runtime/main.c
index e88c2ab..570e959 100644 (file)
--- a/libgfortran/runtime/main.c
+++ b/libgfortran/runtime/main.c
@@ -126,7 +126,7 @@ store_exe_path (const char * argv0)
 
   /* exe_path will be cwd + "/" + argv[0] + "\0" */
   path = malloc (strlen (cwd) + 1 + strlen (argv0) + 1);
 
   /* 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);
+  sprintf (path, "%s%c%s", cwd, DIR_SEPARATOR, argv0);

   exe_path = path;
   please_free_exe_path_when_done = 1;
 }
   exe_path = path;
   please_free_exe_path_when_done = 1;
 }