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

1 files changed, 35 insertions, 0 deletions

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;