[patch] Flag-controlled type conversions/promotions

[Andreas Kloeckner <kloeckner at cims dot nyu dot edu>]

Hi there,

please find attached the patch and the Changelog entry for our work on
the fortran bug #48426.

The attached patch implements the options

-finteger-4-integer-8
-freal-4-real-8
-freal-4-real-10
-freal-4-real-16
-freal-8-real-4
-freal-8-real-10
-freal-8-real-16

to implement a variety of automatic type promotions. (This is particularly
helpful if one wants to quickly check whether a certain code has a bug limiting
its precision away from full machine accuracy.)

A similar promotion feature is available in Fujitsu compilers, see here:

http://www.lahey.com/docs/fujitsu%20compiler%20option%20list.pdf

(e.g. -CcR8R16)

The implementation work on this was done by Zydrunas Gimbutas, not by me.
Zydrunas has authorized me to submit this for inclusion in gcc. Both he
and I have gone through the FSF's copyright assignment process and have
current papers for that on file.

We tested the change by running Kahan's Fortran paranoia tests using all
supported conversions, we ran the LINPACK tests (at all supported
conversions) as well as a number of manually-written conversion tests.

Zydrunas and Andreas

Attachment: pgp00000.pgp
Description: PGP signature

Attachment: Changelog-PR48426
Description: Binary data

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 181224)
+++ gcc/fortran/decl.c	(working copy)
@@ -2097,8 +2097,24 @@
 	  return MATCH_ERROR;
 	}
       ts->kind /= 2;
+
     }
 
+  if (ts->type == BT_INTEGER)
+    {
+      if( ts->kind == 4 && gfc_option.flag_integer4_kind ==  8) ts->kind =  8;
+    }
+
+  if (ts->type == BT_REAL || ts->type == BT_COMPLEX)
+    {
+      if( ts->kind == 4 && gfc_option.flag_real4_kind ==  8) ts->kind =  8;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 10) ts->kind = 10;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 16) ts->kind = 16;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind ==  4) ts->kind =  4;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 10) ts->kind = 10;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 16) ts->kind = 16;
+    }
+
   if (gfc_validate_kind (ts->type, ts->kind, true) < 0)
     {
       gfc_error ("Old-style type declaration %s*%d not supported at %C",
@@ -2243,6 +2259,22 @@
   if(m == MATCH_ERROR)
      gfc_current_locus = where;
   
+
+  if (ts->type == BT_INTEGER)
+    {
+      if( ts->kind == 4 && gfc_option.flag_integer4_kind ==  8) ts->kind =  8;
+    }
+
+  if (ts->type == BT_REAL || ts->type == BT_COMPLEX)
+    {
+      if( ts->kind == 4 && gfc_option.flag_real4_kind ==  8) ts->kind =  8;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 10) ts->kind = 10;
+      if( ts->kind == 4 && gfc_option.flag_real4_kind == 16) ts->kind = 16;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind ==  4) ts->kind =  4;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 10) ts->kind = 10;
+      if( ts->kind == 8 && gfc_option.flag_real8_kind == 16) ts->kind = 16;
+    }
+
   /* Return what we know from the test(s).  */
   return m;
 
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 181224)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -2215,6 +2215,9 @@
   int flag_default_double;
   int flag_default_integer;
   int flag_default_real;
+  int flag_integer4_kind;
+  int flag_real4_kind;
+  int flag_real8_kind;
   int flag_dollar_ok;
   int flag_underscoring;
   int flag_second_underscore;
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt	(revision 181224)
+++ gcc/fortran/lang.opt	(working copy)
@@ -394,6 +394,10 @@
 Fortran RejectNegative
 Assume that the source file is fixed form
 
+finteger-4-integer-8
+Fortran RejectNegative
+Interpret any 4-byte integer as an 8-byte integer
+
 fintrinsic-modules-path
 Fortran RejectNegative Joined Separate
 Specify where to find the compiled intrinsic modules
@@ -494,6 +498,30 @@
 Fortran
 Enable range checking during compilation
 
+freal-4-real-8
+Fortran RejectNegative
+Interpret any 4-byte real as an 8-byte real
+
+freal-4-real-10
+Fortran RejectNegative
+Interpret any 4-byte real as a 10-byte real
+
+freal-4-real-16
+Fortran RejectNegative
+Interpret any 4-byte real as a 16-byte real
+
+freal-8-real-4
+Fortran RejectNegative
+Interpret any 8-byte real as a 4-byte real
+
+freal-8-real-10
+Fortran RejectNegative
+Interpret any 8-byte real as a 10-byte real
+
+freal-8-real-16
+Fortran RejectNegative
+Interpret any 8-byte real as a 16-byte real
+
 frealloc-lhs
 Fortran
 Reallocate the LHS in assignments
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(revision 181224)
+++ gcc/fortran/trans-types.c	(working copy)
@@ -362,7 +362,7 @@
   unsigned int mode;
   int i_index, r_index, kind;
   bool saw_i4 = false, saw_i8 = false;
-  bool saw_r4 = false, saw_r8 = false, saw_r16 = false;
+  bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false;
 
   for (i_index = 0, mode = MIN_MODE_INT; mode <= MAX_MODE_INT; mode++)
     {
@@ -456,6 +456,8 @@
 	saw_r4 = true;
       if (kind == 8)
 	saw_r8 = true;
+      if (kind == 10)
+	saw_r10 = true;
       if (kind == 16)
 	saw_r16 = true;
 
@@ -495,6 +497,17 @@
 	 be issued when NUMERIC_STORAGE_SIZE is used.  */
       gfc_numeric_storage_size = 4 * 8;
     }
+  else if (saw_i8 && gfc_option.flag_integer4_kind == 8 )
+    {
+      if (!saw_i8)
+	fatal_error ("integer kind=8 not available for -finteger-4-integer-8 option");
+      gfc_default_integer_kind = 8;
+
+      /* Even if the user specified that the default integer kind be 8,
+         the numeric storage size isn't 64.  In this case, a warning will
+	 be issued when NUMERIC_STORAGE_SIZE is used.  */
+      gfc_numeric_storage_size = 4 * 8;
+    }
   else if (saw_i4)
     {
       gfc_default_integer_kind = 4;
@@ -513,6 +526,24 @@
 	fatal_error ("real kind=8 not available for -fdefault-real-8 option");
       gfc_default_real_kind = 8;
     }
+  else if (gfc_option.flag_real4_kind == 8 )
+  {
+    if (!saw_r8)
+      fatal_error ("real kind=8 not available for -freal-4-real-8 option");
+    gfc_default_real_kind = 8;
+  }
+  else if (gfc_option.flag_real4_kind == 10 )
+  {
+    if (!saw_r10)
+      fatal_error ("real kind=10 not available for -freal-4-real-10 option");
+    gfc_default_real_kind = 10;
+  }
+  else if (gfc_option.flag_real4_kind == 16 )
+  {
+    if (!saw_r16)
+      fatal_error ("real kind=16 not available for -freal-4-real-16 option");
+    gfc_default_real_kind = 16;
+  }
   else if (saw_r4)
     gfc_default_real_kind = 4;
   else
@@ -529,6 +560,24 @@
     gfc_default_double_kind = 8;
   else if (gfc_option.flag_default_real && saw_r16)
     gfc_default_double_kind = 16;
+  else if (gfc_option.flag_real8_kind == 4 )
+  {
+    if (!saw_r4)
+      fatal_error ("real kind=4 not available for -freal-8-real-4 option");
+    gfc_default_double_kind = 4;
+  }
+  else if (gfc_option.flag_real8_kind == 10 )
+  {
+    if (!saw_r10)
+      fatal_error ("real kind=10 not available for -freal-8-real-10 option");
+    gfc_default_double_kind = 10;
+  }
+  else if (gfc_option.flag_real8_kind == 16 )
+  {
+    if (!saw_r16)
+      fatal_error ("real kind=10 not available for -freal-8-real-16 option");
+    gfc_default_double_kind = 16;
+  }
   else if (saw_r4 && saw_r8)
     gfc_default_double_kind = 8;
   else
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 181224)
+++ gcc/fortran/primary.c	(working copy)
@@ -224,6 +224,8 @@
   if (kind == -1)
     return MATCH_ERROR;
 
+  if( kind == 4 && gfc_option.flag_integer4_kind ==  8) kind =  8;
+
   if (gfc_validate_kind (BT_INTEGER, kind, true) < 0)
     {
       gfc_error ("Integer kind %d at %C not available", kind);
@@ -636,6 +638,14 @@
 	  goto cleanup;
 	}
       kind = gfc_default_double_kind;
+
+      if (kind == 4 && gfc_option.flag_real4_kind ==  8) kind =  8;
+      if (kind == 4 && gfc_option.flag_real4_kind == 10) kind = 10;
+      if (kind == 4 && gfc_option.flag_real4_kind == 16) kind = 16;
+      if (kind == 8 && gfc_option.flag_real8_kind ==  4) kind =  4;
+      if (kind == 8 && gfc_option.flag_real8_kind == 10) kind = 10;
+      if (kind == 8 && gfc_option.flag_real8_kind == 16) kind = 16;
+
       break;
 
     case 'q':
@@ -666,6 +676,13 @@
       if (kind == -2)
 	kind = gfc_default_real_kind;
 
+      if (kind == 4 && gfc_option.flag_real4_kind ==  8) kind =  8;
+      if (kind == 4 && gfc_option.flag_real4_kind == 10) kind = 10;
+      if (kind == 4 && gfc_option.flag_real4_kind == 16) kind = 16;
+      if (kind == 8 && gfc_option.flag_real8_kind ==  4) kind =  4;
+      if (kind == 8 && gfc_option.flag_real8_kind == 10) kind = 10;
+      if (kind == 8 && gfc_option.flag_real8_kind == 16) kind = 16;
+
       if (gfc_validate_kind (BT_REAL, kind, true) < 0)
 	{
 	  gfc_error ("Invalid real kind %d at %C", kind);
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c	(revision 181224)
+++ gcc/fortran/options.c	(working copy)
@@ -116,6 +116,9 @@
   gfc_option.flag_default_double = 0;
   gfc_option.flag_default_integer = 0;
   gfc_option.flag_default_real = 0;
+  gfc_option.flag_integer4_kind = 0;
+  gfc_option.flag_real4_kind = 0;
+  gfc_option.flag_real8_kind = 0;
   gfc_option.flag_dollar_ok = 0;
   gfc_option.flag_underscoring = 1;
   gfc_option.flag_whole_file = 1;
@@ -849,6 +852,34 @@
       gfc_option.flag_default_double = value;
       break;
 
+    case OPT_finteger_4_integer_8:
+      gfc_option.flag_integer4_kind = 8;
+      break;
+
+    case OPT_freal_4_real_8:
+      gfc_option.flag_real4_kind = 8;
+      break;
+
+    case OPT_freal_4_real_10:
+      gfc_option.flag_real4_kind = 10;
+      break;
+
+    case OPT_freal_4_real_16:
+      gfc_option.flag_real4_kind = 16;
+      break;
+
+    case OPT_freal_8_real_4:
+      gfc_option.flag_real8_kind = 4;
+      break;
+
+    case OPT_freal_8_real_10:
+      gfc_option.flag_real8_kind = 10;
+      break;
+
+    case OPT_freal_8_real_16:
+      gfc_option.flag_real8_kind = 16;
+      break;
+
     case OPT_finit_local_zero:
       gfc_option.flag_init_integer = GFC_INIT_INTEGER_ON;
       gfc_option.flag_init_integer_value = 0;

-- 
Andreas Kloeckner 
Room 1105A (Warren Weaver Hall), Courant Institute, NYU
http://www.cims.nyu.edu/~kloeckner/
+1-401-648-0599