re PR fortran/48720 (quad precision literals do not work)

2011-05-02  Steven G. Kargl  <kargl@gcc.gnu.org>

    PR fortran/48720
    * gfortran.texi: Document the 'Q' exponent-letter extension.
    * invoke.texi: Document -Wreal-q-constant.
    * lang.opt: Add -Wreal-q-constant option.
    * gfortran.h: Add warn_real_q_constant to option struct.
    * primary.c (match_real_constant):  Use it.  Accept 'Q' as
    exponent-letter for REAL(16) real-literal-constant with a
    fallback to REAL(10) or error if REAL(10) is not available.
    * options.c (gfc_init_options, set_Wall) Set it.
    (gfc_handle_option): Handle new option.

From-SVN: r173285

7 files changed, 86 insertions, 7 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 59a4d35..89669e5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2011-05-02  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/48720
+	* gfortran.texi: Document the 'Q' exponent-letter extension.
+	* invoke.texi: Document -Wreal-q-constant.
+	* lang.opt: Add -Wreal-q-constant option.
+	* gfortran.h: Add warn_real_q_constant to option struct.
+	* primary.c (match_real_constant):  Use it.  Accept 'Q' as
+	exponent-letter for REAL(16) real-literal-constant with a
+	fallback to REAL(10) or error if REAL(10) is not available.
+	* options.c (gfc_init_options, set_Wall) Set it.
+	(gfc_handle_option): Handle new option.
+
 2011-04-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* dump-prase-tree.c (show_code_node):  Set the current
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 1d725e4..b127f6f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2189,6 +2189,7 @@ typedef struct
   int warn_character_truncation;
   int warn_array_temp;
   int warn_align_commons;
+  int warn_real_q_constant;
   int warn_unused_dummy_argument;
   int max_errors;
 
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index bbd8b2e..1284c3d 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1237,6 +1237,7 @@ without warning.
 * Missing period in FORMAT specifications::
 * I/O item lists::
 * BOZ literal constants::
+* @code{Q} exponent-letter::
 * Real array indices::
 * Unary operators::
 * Implicitly convert LOGICAL and INTEGER values::
@@ -1427,6 +1428,18 @@ To support legacy codes, GNU Fortran allows the input item list
 of the @code{READ} statement, and the output item lists of the
 @code{WRITE} and @code{PRINT} statements, to start with a comma.
 
+@node @code{Q} exponent-letter
+@subsection @code{Q} exponent-letter
+@cindex @code{Q} exponent-letter
+
+GNU Fortran accepts real literal constants with an exponent-letter
+of @code{Q}, for example, @code{1.23Q45}.  The constant is interpreted
+as a @code{REAL(16)} entity on targets that suppports this type.  If
+the target does not support @code{REAL(16)} but has a @code{REAL(10)}
+type, then the real-literal-constant will be interpreted as a
+@code{REAL(10)} entity.  In the absence of @code{REAL(16)} and
+@code{REAL(10)}, an error will occur.
+
 @node BOZ literal constants
 @subsection BOZ literal constants
 @cindex BOZ literal constants
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 57f7313..0874e5c 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -134,12 +134,13 @@ by type.  Explanations are in the following sections.
 @item Error and Warning Options
 @xref{Error and Warning Options,,Options to request or suppress errors
 and warnings}.
-@gccoptlist{-fmax-errors=@var{n} @gol
--fsyntax-only  -pedantic  -pedantic-errors @gol
--Wall  -Waliasing  -Wampersand  -Warray-bounds -Wcharacter-truncation @gol
--Wconversion -Wimplicit-interface  -Wimplicit-procedure  -Wline-truncation @gol
--Wintrinsics-std  -Wsurprising  -Wno-tabs  -Wunderflow  -Wunused-parameter @gol
--Wintrinsic-shadow  -Wno-align-commons -Wfunction-elimination}
+@gccoptlist{-fmax-errors=@var{n}
+-fsyntax-only -pedantic -pedantic-errors -Wall @gol
+-Waliasing -Wampersand -Warray-bounds -Wcharacter-truncation @gol
+-Wconversion -Wimplicit-interface -Wimplicit-procedure -Wline-truncation @gol
+-Wintrinsics-std -Wreal-q-constant -Wsurprising -Wno-tabs -Wunderflow @gol
+-Wunused-parameter -Wintrinsic-shadow -Wno-align-commons @gol
+-Wfunction-elimination}
 
 @item Debugging Options
 @xref{Debugging Options,,Options for debugging your program or GNU Fortran}.
@@ -694,7 +695,7 @@ we recommend avoiding and that we believe are easy to avoid.
 This currently includes @option{-Waliasing}, @option{-Wampersand}, 
 @option{-Wconversion}, @option{-Wsurprising}, @option{-Wintrinsics-std},
 @option{-Wno-tabs}, @option{-Wintrinsic-shadow}, @option{-Wline-truncation},
-and @option{-Wunused}.
+@option{-Wreal-q-constant} and @option{-Wunused}.
 
 @item -Waliasing
 @opindex @code{Waliasing}
@@ -782,6 +783,12 @@ it as @code{EXTERNAL} procedure because of this.  @option{-fall-intrinsics} can
 be used to never trigger this behavior and always link to the intrinsic
 regardless of the selected standard.
 
+@item -Wreal-q-constant
+@opindex @code{Wreal-q-constant}
+@cindex warnings, @code{q} exponent-letter
+Produce a warning if a real-literal-constant contains a @code{q}
+exponent-letter.
+
 @item -Wsurprising
 @opindex @code{Wsurprising}
 @cindex warnings, suspicious code
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 3055825..015493e 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -242,6 +242,10 @@ Wintrinsics-std
 Fortran Warning
 Warn on intrinsics not part of the selected standard
 
+Wreal-q-constant
+Fortran Warning
+Warn about real-literal-constants with 'q' exponent-letter
+
 Wreturn-type
 Fortran Warning
 ; Documented in C
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 9c0e000..f56fad7 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -108,6 +108,7 @@ gfc_init_options (unsigned int decoded_options_count,
   gfc_option.warn_intrinsic_shadow = 0;
   gfc_option.warn_intrinsics_std = 0;
   gfc_option.warn_align_commons = 1;
+  gfc_option.warn_real_q_constant = 0;
   gfc_option.warn_unused_dummy_argument = 0;
   gfc_option.max_errors = 25;
 
@@ -455,6 +456,7 @@ set_Wall (int setting)
   gfc_option.warn_intrinsic_shadow = setting;
   gfc_option.warn_intrinsics_std = setting;
   gfc_option.warn_character_truncation = setting;
+  gfc_option.warn_real_q_constant = setting;
   gfc_option.warn_unused_dummy_argument = setting;
 
   warn_unused = setting;
@@ -660,6 +662,10 @@ gfc_handle_option (size_t scode, const char *arg, int value,
       gfc_option.warn_align_commons = value;
       break;
 
+    case OPT_Wreal_q_constant:
+      gfc_option.warn_real_q_constant = value;
+      break;
+
     case OPT_Wunused_dummy_argument:
       gfc_option.warn_unused_dummy_argument = value;
       break;
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 15cb9a4..8f3c7e5 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -541,6 +541,17 @@ match_real_constant (gfc_expr **result, int signflag)
     goto done;
   exp_char = c;
 
+
+  if (c == 'q')
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: exponent-letter 'q' in "
+			 "real-literal-constant at %C") == FAILURE)
+	return MATCH_ERROR;
+      else if (gfc_option.warn_real_q_constant)
+	gfc_warning("Extension: exponent-letter 'q' in real-literal-constant "
+		    "at %C");
+    }
+
   /* Scan exponent.  */
   c = gfc_next_ascii_char ();
   count++;
@@ -616,6 +627,30 @@ done:
       kind = gfc_default_double_kind;
       break;
 
+    case 'q':
+      if (kind != -2)
+	{
+	  gfc_error ("Real number at %C has a 'q' exponent and an explicit "
+		     "kind");
+	  goto cleanup;
+	}
+
+      /* The maximum possible real kind type parameter is 16.  First, try
+	 that for the kind, then fallback to trying kind=10 (Intel 80 bit)
+	 extended precision.  If neither value works, just given up.  */
+      kind = 16;
+      if (gfc_validate_kind (BT_REAL, kind, true) < 0)
+	{
+	  kind = 10;
+          if (gfc_validate_kind (BT_REAL, kind, true) < 0)
+	    {
+	      gfc_error ("Invalid exponent-letter 'q' in "
+			 "real-literal-constant at %C");
+	      goto cleanup;
+	    }
+	}
+      break;
+
     default:
       if (kind == -2)
 	kind = gfc_default_real_kind;