From 7833ddd7f2851ef118671abc07af7cedfd7fe1ed Mon Sep 17 00:00:00 2001
From: fxcoudert <fxcoudert@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Wed, 8 Feb 2006 20:54:14 +0000
Subject: [PATCH] PR libfortran/25425
* trans-decl.c (gfc_generate_function_code): Add new argument,
pedantic, to set_std call.
* libgfortran.h: Add pedantic field to compile_options struct.
* io/write.c (calculate_G_format): Depending on the standard,
choose E or F format for list-directed output of 0.0.
* runtime/error.c (notify_std): Make warning and error dependent
on pedanticity.
* runtime/compile_options.c (set_std): Use new pedantic argument.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@110769 138bc75d-0d04-0410-961f-82ee72b054a4
---
gcc/fortran/ChangeLog | 6 ++++++
gcc/fortran/trans-decl.c | 14 +++++++++-----
libgfortran/ChangeLog | 14 ++++++++++++--
libgfortran/io/write.c | 3 ++-
libgfortran/libgfortran.h | 1 +
libgfortran/runtime/compile_options.c | 7 +++++--
libgfortran/runtime/error.c | 5 ++++-
7 files changed, 39 insertions(+), 11 deletions(-)
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 66f638f63014..83dd30cdb786 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2006-02-08 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR libfortran/25425
+ * trans-decl.c (gfc_generate_function_code): Add new argument,
+ pedantic, to set_std call.
+
2005-02-06 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/23815
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4811b7a1d603..d1892b7fdd85 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2226,7 +2226,8 @@ gfc_build_builtin_function_decls (void)
gfor_fndecl_set_std =
gfc_build_library_function_decl (get_identifier (PREFIX("set_std")),
void_type_node,
- 2,
+ 3,
+ gfc_int4_type_node,
gfc_int4_type_node,
gfc_int4_type_node);
@@ -2817,10 +2818,10 @@ gfc_generate_function_code (gfc_namespace * ns)
/* Now generate the code for the body of this function. */
gfc_init_block (&body);
- /* If this is the main program and we compile with -pedantic, add a call
- to set_std to set up the runtime library Fortran language standard
- parameters. */
- if (sym->attr.is_main_program && pedantic)
+ /* If this is the main program, add a call to set_std to set up the
+ runtime library Fortran language standard parameters. */
+
+ if (sym->attr.is_main_program)
{
tree arglist, gfc_int4_type_node;
@@ -2831,6 +2832,9 @@ gfc_generate_function_code (gfc_namespace * ns)
arglist = gfc_chainon_list (arglist,
build_int_cst (gfc_int4_type_node,
gfc_option.allow_std));
+ arglist = gfc_chainon_list (arglist,
+ build_int_cst (gfc_int4_type_node,
+ pedantic));
tmp = build_function_call_expr (gfor_fndecl_set_std, arglist);
gfc_add_expr_to_block (&body, tmp);
}
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 8517787a1a77..a8e881d45fae 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2006-02-08 Francois-Xavier Coudert <coudert@clipper.ens.fr>
+
+ PR libfortran/25425
+ * libgfortran.h: Add pedantic field to compile_options struct.
+ * io/write.c (calculate_G_format): Depending on the standard,
+ choose E or F format for list-directed output of 0.0.
+ * runtime/error.c (notify_std): Make warning and error dependent
+ on pedanticity.
+ * runtime/compile_options.c (set_std): Use new pedantic argument.
+
2006-02-07 Dale Ranta <dir@lanl.gov>
PR fortran/25577
@@ -6,8 +16,8 @@
2006-02-07 Rainer Emrich <r.emrich@de.tecosim.com>
* intrinsics/c99_functions.c: Work around incompatible
- declarations of cabs{,f,l} on pre-C99 IRIX systems.
-
+ declarations of cabs{,f,l} on pre-C99 IRIX systems.
+
2005-02-06 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/23815
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index d7ce6c56807d..edd2933c3de1 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -302,7 +302,8 @@ calculate_G_format (st_parameter_dt *dtp, const fnode *f,
/* In case of the two data magnitude ranges,
generate E editing, Ew.d[Ee]. */
exp_d = calculate_exp (d);
- if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ))
+ if ((m > 0.0 && m < 0.1 - 0.05 / exp_d) || (m >= exp_d - 0.5 ) ||
+ ((m == 0.0) && !(compile_options.allow_std & GFC_STD_F2003)))
{
newf->format = FMT_E;
newf->u.real.w = w;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index fac9b4ab328b..f1a1a3e7e1c7 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -336,6 +336,7 @@ typedef struct
{
int warn_std;
int allow_std;
+ int pedantic;
int convert;
}
compile_options_t;
diff --git a/libgfortran/runtime/compile_options.c b/libgfortran/runtime/compile_options.c
index e2a2ffa4c802..ce5e52a34da7 100644
--- a/libgfortran/runtime/compile_options.c
+++ b/libgfortran/runtime/compile_options.c
@@ -37,13 +37,15 @@ compile_options_t compile_options;
/* Prototypes */
-extern void set_std (GFC_INTEGER_4, GFC_INTEGER_4);
+extern void set_std (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)
+set_std (GFC_INTEGER_4 warn_std, GFC_INTEGER_4 allow_std,
+ GFC_INTEGER_4 pedantic)
{
+ compile_options.pedantic = pedantic;
compile_options.warn_std = warn_std;
compile_options.allow_std = allow_std;
}
@@ -58,6 +60,7 @@ init_compile_options (void)
| GFC_STD_F2003 | GFC_STD_LEGACY;
compile_options.allow_std = GFC_STD_F95_OBS | GFC_STD_F95_DEL
| GFC_STD_F2003 | GFC_STD_F95 | GFC_STD_F77 | GFC_STD_GNU | GFC_STD_LEGACY;
+ compile_options.pedantic = 0;
}
/* Function called by the front-end to tell us the
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 2d3c0689adc2..b25cd0c8c160 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -508,6 +508,9 @@ notify_std (int std, const char * message)
{
int warning;
+ if (!compile_options.pedantic)
+ return SUCCESS;
+
warning = compile_options.warn_std & std;
if ((compile_options.allow_std & std) != 0 && !warning)
return SUCCESS;
--
GitLab