iso-fortran-env.def: Define INT8, INT16, INT32, INT64, REAL32, REAL64 and REAL128.

	* iso-fortran-env.def: Define INT8, INT16, INT32, INT64, REAL32,
	REAL64 and REAL128.
	* gfortran.h (gfc_get_int_kind_from_width_isofortranenv,
	gfc_get_real_kind_from_width_isofortranenv): New prototypes.
	* iso-c-binding.def: Update definitions for the INT*_T,
	INT_LEAST*_T and INT_FAST*_T named parameters.
	* trans-types.c (get_typenode_from_name, get_int_kind_from_name,
	gfc_get_real_kind_from_width_isofortranenv): New functions.

	* gfortran.dg/c_kind_int128_test1.f03: Also test C_INT_FAST128_T.
	* gfortran.dg/c_kind_int128_test2.f03: Update comment.
	* gfortran.dg/c_kind_params.f90: Also test int_fast*_t.
	* gfortran.dg/c_kinds.c: Add int_fast*_t arguments.

From-SVN: r147635

10 files changed, 174 insertions, 47 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b799e51..a9409f3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,16 @@
 2009-05-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+	* iso-fortran-env.def: Define INT8, INT16, INT32, INT64, REAL32,
+	REAL64 and REAL128.
+	* gfortran.h (gfc_get_int_kind_from_width_isofortranenv,
+	gfc_get_real_kind_from_width_isofortranenv): New prototypes.
+	* iso-c-binding.def: Update definitions for the INT*_T,
+	INT_LEAST*_T and INT_FAST*_T named parameters.
+	* trans-types.c (get_typenode_from_name, get_int_kind_from_name,
+	gfc_get_real_kind_from_width_isofortranenv): New functions.
+
+2009-05-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
 	PR fortran/36260
 	* intrinsic.c (add_functions, add_subroutines): Fix argument
 	names and wrap long lines.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b38af18..abde778 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2254,6 +2254,8 @@ bool gfc_check_character_range (gfc_char_t, int);
 /* trans-types.c */
 gfc_try gfc_check_any_c_kind (gfc_typespec *);
 int gfc_validate_kind (bt, int, bool);
+int gfc_get_int_kind_from_width_isofortranenv (int size);
+int gfc_get_real_kind_from_width_isofortranenv (int size);
 extern int gfc_index_integer_kind;
 extern int gfc_default_integer_kind;
 extern int gfc_max_integer_kind;
diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def
index 98c3c98..94c12fd 100644
--- a/gcc/fortran/iso-c-binding.def
+++ b/gcc/fortran/iso-c-binding.def
@@ -56,41 +56,44 @@ NAMED_INTCST (ISOCBINDING_LONG_LONG, "c_long_long", \
 NAMED_INTCST (ISOCBINDING_INTMAX_T, "c_intmax_t", \
               get_int_kind_from_node (intmax_type_node), GFC_STD_F2003)
 NAMED_INTCST (ISOCBINDING_INTPTR_T, "c_intptr_t", \
-              get_int_kind_from_node (ptr_type_node), GFC_STD_F2003)
+              get_int_kind_from_name (INTPTR_TYPE), GFC_STD_F2003)
 NAMED_INTCST (ISOCBINDING_SIZE_T, "c_size_t", \
               gfc_index_integer_kind, GFC_STD_F2003)
 NAMED_INTCST (ISOCBINDING_SIGNED_CHAR, "c_signed_char", \
               get_int_kind_from_node (signed_char_type_node), GFC_STD_F2003)
 
-NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", get_int_kind_from_width (8), \
-              GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", get_int_kind_from_width (16), \
-              GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", get_int_kind_from_width (32), \
-              GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", get_int_kind_from_width (64), \
-              GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT8_T, "c_int8_t", \
+              get_int_kind_from_name (INT8_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", \
+              get_int_kind_from_name (INT16_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", \
+              get_int_kind_from_name (INT32_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", \
+              get_int_kind_from_name (INT64_TYPE), GFC_STD_F2003)
 /* GNU Extension.  */
-NAMED_INTCST (ISOCBINDING_INT128_T, "c_int128_t", get_int_kind_from_width (128), \
-              GFC_STD_GNU)
+NAMED_INTCST (ISOCBINDING_INT128_T, "c_int128_t", \
+              get_int_kind_from_width (128), GFC_STD_GNU)
 
 NAMED_INTCST (ISOCBINDING_INT_LEAST8_T, "c_int_least8_t", \
-              get_int_kind_from_minimal_width (8), GFC_STD_F2003)
+              get_int_kind_from_name (INT_LEAST8_TYPE), GFC_STD_F2003)
 NAMED_INTCST (ISOCBINDING_INT_LEAST16_T, "c_int_least16_t", \
-              get_int_kind_from_minimal_width (16), GFC_STD_F2003)
+              get_int_kind_from_name (INT_LEAST16_TYPE), GFC_STD_F2003)
 NAMED_INTCST (ISOCBINDING_INT_LEAST32_T, "c_int_least32_t", \
-              get_int_kind_from_minimal_width (32), GFC_STD_F2003)
+              get_int_kind_from_name (INT_LEAST32_TYPE), GFC_STD_F2003)
 NAMED_INTCST (ISOCBINDING_INT_LEAST64_T, "c_int_least64_t", \
-              get_int_kind_from_minimal_width (64), GFC_STD_F2003)
+              get_int_kind_from_name (INT_LEAST64_TYPE), GFC_STD_F2003)
 /* GNU Extension.  */
 NAMED_INTCST (ISOCBINDING_INT_LEAST128_T, "c_int_least128_t", \
               get_int_kind_from_minimal_width (128), GFC_STD_GNU)
 
-/* TODO: Implement c_int_fast*_t. Depends on PR 448.  */ 
-NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", -2, GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", -2, GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", -2, GFC_STD_F2003)
-NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", -2, GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST8_T, "c_int_fast8_t", \
+              get_int_kind_from_name (INT_FAST8_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", \
+              get_int_kind_from_name (INT_FAST16_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", \
+              get_int_kind_from_name (INT_FAST32_TYPE), GFC_STD_F2003)
+NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", \
+              get_int_kind_from_name (INT_FAST64_TYPE), GFC_STD_F2003)
 /* GNU Extension.  */
 NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t", -2, GFC_STD_GNU)
 
diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def
index 5f2c042..fa6071f 100644
--- a/gcc/fortran/iso-fortran-env.def
+++ b/gcc/fortran/iso-fortran-env.def
@@ -33,6 +33,14 @@ NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8, \
               GFC_STD_F2003)
 NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", GFC_STDIN_UNIT_NUMBER, \
               GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_INT8, "int8", \
+              gfc_get_int_kind_from_width_isofortranenv (8), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_INT16, "int16", \
+              gfc_get_int_kind_from_width_isofortranenv (16), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_INT32, "int32", \
+              gfc_get_int_kind_from_width_isofortranenv (32), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_INT64, "int64", \
+              gfc_get_int_kind_from_width_isofortranenv (64), GFC_STD_F2008)
 NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END, \
               GFC_STD_F2003)
 NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR, \
@@ -41,3 +49,9 @@ NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \
               gfc_numeric_storage_size, GFC_STD_F2003)
 NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", GFC_STDOUT_UNIT_NUMBER, \
               GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_REAL32, "real32", \
+              gfc_get_real_kind_from_width_isofortranenv (32), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_REAL64, "real64", \
+              gfc_get_real_kind_from_width_isofortranenv (64), GFC_STD_F2008)
+NAMED_INTCST (ISOFORTRANENV_REAL128, "real128", \
+              gfc_get_real_kind_from_width_isofortranenv (128), GFC_STD_F2008)
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index ae72e8d..b40af41 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -163,6 +163,96 @@ get_int_kind_from_node (tree type)
   return -1;
 }
 
+/* Return a typenode for the "standard" C type with a given name.  */
+static tree
+get_typenode_from_name (const char *name)
+{
+  if (name == NULL || *name == '\0')
+    return NULL_TREE;
+
+  if (strcmp (name, "char") == 0)
+    return char_type_node;
+  if (strcmp (name, "unsigned char") == 0)
+    return unsigned_char_type_node;
+  if (strcmp (name, "signed char") == 0)
+    return signed_char_type_node;
+
+  if (strcmp (name, "short int") == 0)
+    return short_integer_type_node;
+  if (strcmp (name, "short unsigned int") == 0)
+    return short_unsigned_type_node;
+
+  if (strcmp (name, "int") == 0)
+    return integer_type_node;
+  if (strcmp (name, "unsigned int") == 0)
+    return unsigned_type_node;
+
+  if (strcmp (name, "long int") == 0)
+    return long_integer_type_node;
+  if (strcmp (name, "long unsigned int") == 0)
+    return long_unsigned_type_node;
+
+  if (strcmp (name, "long long int") == 0)
+    return long_long_integer_type_node;
+  if (strcmp (name, "long long unsigned int") == 0)
+    return long_long_unsigned_type_node;
+
+  gcc_unreachable ();
+}
+
+static int
+get_int_kind_from_name (const char *name)
+{
+  return get_int_kind_from_node (get_typenode_from_name (name));
+}
+
+
+/* Get the kind number corresponding to an integer of given size,
+   following the required return values for ISO_FORTRAN_ENV INT* constants:
+   -2 is returned if we support a kind of larger size, -1 otherwise.  */
+int
+gfc_get_int_kind_from_width_isofortranenv (int size)
+{
+  int i;
+
+  /* Look for a kind with matching storage size.  */
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size == size)
+      return gfc_integer_kinds[i].kind;
+
+  /* Look for a kind with larger storage size.  */
+  for (i = 0; gfc_integer_kinds[i].kind != 0; i++)
+    if (gfc_integer_kinds[i].bit_size > size)
+      return -2;
+
+  return -1;
+}
+
+/* Get the kind number corresponding to a real of given storage size,
+   following the required return values for ISO_FORTRAN_ENV REAL* constants:
+   -2 is returned if we support a kind of larger size, -1 otherwise.  */
+int
+gfc_get_real_kind_from_width_isofortranenv (int size)
+{
+  int i;
+
+  size /= 8;
+
+  /* Look for a kind with matching storage size.  */
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) == size)
+      return gfc_real_kinds[i].kind;
+
+  /* Look for a kind with larger storage size.  */
+  for (i = 0; gfc_real_kinds[i].kind != 0; i++)
+    if (int_size_in_bytes (gfc_get_real_type (gfc_real_kinds[i].kind)) > size)
+      return -2;
+
+  return -1;
+}
+
+
+
 static int
 get_int_kind_from_width (int size)
 {
@@ -680,6 +770,7 @@ gfc_build_logical_type (gfc_logical_info *info)
   return new_type;
 }
 
+
 #if 0
 /* Return the bit size of the C "size_t".  */
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 41a1338..7007901 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-05-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+	* gfortran.dg/c_kind_int128_test1.f03: Also test C_INT_FAST128_T.
+	* gfortran.dg/c_kind_int128_test2.f03: Update comment.
+	* gfortran.dg/c_kind_params.f90: Also test int_fast*_t.
+	* gfortran.dg/c_kinds.c: Add int_fast*_t arguments.
+
 2009-05-16  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	PR fortran/33197
diff --git a/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03 b/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
index 6be1ac2..b1919614 100644
--- a/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
+++ b/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
@@ -2,7 +2,6 @@
 ! { dg-options "-std=f2003" }
 ! { dg-require-effective-target fortran_integer_16 }
 !
-! Note: int_fast*_t currently not supported.
 
 subroutine c_kind_int128_1
   use, intrinsic :: iso_c_binding
@@ -10,15 +9,16 @@ subroutine c_kind_int128_1
 
   integer(c_int128_t) :: a   ! { dg-error "has no IMPLICIT type" }
   integer(c_int_least128_t) :: b   ! { dg-error "has no IMPLICIT type" }
-! integer(c_int_fast128_t) :: c   
-   
+  integer(c_int_fast128_t) :: c   ! { dg-error "has no IMPLICIT type" }
+
 end subroutine c_kind_int128_1
 
+
 subroutine c_kind_int128_2
   use, intrinsic :: iso_c_binding
 
   integer(c_int128_t) :: a   ! { dg-error "has not been declared or is a variable" }
   integer(c_int_least128_t) :: b   ! { dg-error "has not been declared or is a variable" }
-! integer(c_int_fast128_t) :: c   
-   
+  integer(c_int_fast128_t) :: c   ! { dg-error "has not been declared or is a variable" }
+
 end subroutine c_kind_int128_2
diff --git a/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03 b/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
index 2f22b72..4fe2dac 100644
--- a/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
+++ b/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
@@ -2,7 +2,7 @@
 ! { dg-options "-std=gnu" }
 ! { dg-require-effective-target fortran_integer_16 }
 !
-! Note: int_fast*_t currently not supported.
+! Note: int_fast128_t currently not supported.
 
 program c_kind_int128
   use, intrinsic :: iso_c_binding
diff --git a/gcc/testsuite/gfortran.dg/c_kind_params.f90 b/gcc/testsuite/gfortran.dg/c_kind_params.f90
index 871ae82..4176157 100644
--- a/gcc/testsuite/gfortran.dg/c_kind_params.f90
+++ b/gcc/testsuite/gfortran.dg/c_kind_params.f90
@@ -5,16 +5,16 @@
 ! the -w option is needed to make f951 not report a warning for 
 ! the -std=c99 option that the C file needs.
 !
-! Note: int_fast*_t currently not supported, cf. PR 448.
 module c_kind_params
   use, intrinsic :: iso_c_binding
   implicit none
 
 contains
   subroutine param_test(my_short, my_int, my_long, my_long_long, &
-       my_int8_t, my_int_least8_t, my_int16_t, &
-       my_int_least16_t, my_int32_t, my_int_least32_t, &
-       my_int64_t, my_int_least64_t, &
+       my_int8_t, my_int_least8_t, my_int_fast8_t, &
+       my_int16_t, my_int_least16_t, my_int_fast16_t, &
+       my_int32_t, my_int_least32_t, my_int_fast32_t, &
+       my_int64_t, my_int_least64_t, my_int_fast64_t, &
        my_intmax_t, my_intptr_t, my_float, my_double, my_long_double, &
        my_char, my_bool) bind(c)
     integer(c_short), value :: my_short
@@ -23,16 +23,16 @@ contains
     integer(c_long_long), value :: my_long_long
     integer(c_int8_t), value :: my_int8_t
     integer(c_int_least8_t), value :: my_int_least8_t
-!   integer(c_int_fast8_t), value :: my_int_fast8_t
+    integer(c_int_fast8_t), value :: my_int_fast8_t
     integer(c_int16_t), value :: my_int16_t
     integer(c_int_least16_t), value :: my_int_least16_t
-!   integer(c_int_fast16_t), value :: my_int_fast16_t
+    integer(c_int_fast16_t), value :: my_int_fast16_t
     integer(c_int32_t), value :: my_int32_t
     integer(c_int_least32_t), value :: my_int_least32_t
-!   integer(c_int_fast32_t), value :: my_int_fast32_t
+    integer(c_int_fast32_t), value :: my_int_fast32_t
     integer(c_int64_t), value :: my_int64_t
     integer(c_int_least64_t), value :: my_int_least64_t
-!   integer(c_int_fast64_t), value :: my_int_fast64_t
+    integer(c_int_fast64_t), value :: my_int_fast64_t
     integer(c_intmax_t), value :: my_intmax_t
     integer(c_intptr_t), value :: my_intptr_t
     real(c_float), value :: my_float
@@ -48,19 +48,19 @@ contains
 
     if(my_int8_t      /= 1_c_int8_t)        call abort()
     if(my_int_least8_t  /= 2_c_int_least8_t ) call abort()
-    print *, 'c_int_fast8_t is:        ', c_int_fast8_t
+    if(my_int_fast8_t  /= 3_c_int_fast8_t ) call abort()
 
     if(my_int16_t     /= 1_c_int16_t)       call abort()
     if(my_int_least16_t /= 2_c_int_least16_t) call abort()
-    print *, 'c_int_fast16_t is:       ', c_int_fast16_t
+    if(my_int_fast16_t  /= 3_c_int_fast16_t ) call abort()
 
     if(my_int32_t     /= 1_c_int32_t)       call abort()
     if(my_int_least32_t /= 2_c_int_least32_t) call abort()
-    print *, 'c_int_fast32_t is:       ', c_int_fast32_t
+    if(my_int_fast32_t  /= 3_c_int_fast32_t ) call abort()
 
     if(my_int64_t     /= 1_c_int64_t)       call abort()
     if(my_int_least64_t /= 2_c_int_least64_t) call abort()
-    print *, 'c_int_fast64_t is:       ', c_int_fast64_t
+    if(my_int_fast64_t  /= 3_c_int_fast64_t ) call abort()
 
     if(my_intmax_t /= 1_c_intmax_t) call abort()
     if(my_intptr_t /= 0_c_intptr_t) call abort()
diff --git a/gcc/testsuite/gfortran.dg/c_kinds.c b/gcc/testsuite/gfortran.dg/c_kinds.c
index f79a70f..8fb658a 100644
--- a/gcc/testsuite/gfortran.dg/c_kinds.c
+++ b/gcc/testsuite/gfortran.dg/c_kinds.c
@@ -3,15 +3,14 @@
 
 #include <stdint.h>
 
-/* Note: int_fast*_t is currently not supported, cf. PR 448 */
 void param_test(short int my_short, int my_int, long int my_long,
                 long long int my_long_long, int8_t my_int8_t,
-                int_least8_t my_int_least8_t, /*int_fast8_t my_int_fast8_t,*/
+                int_least8_t my_int_least8_t, int_fast8_t my_int_fast8_t,
                 int16_t my_int16_t, int_least16_t my_int_least16_t,
-                /*int_fast16_t my_int_fast16_t,*/ int32_t my_int32_t,
-                int_least32_t my_int_least32_t, /*int_fast32_t my_int_fast32_t,*/
+                int_fast16_t my_int_fast16_t, int32_t my_int32_t,
+                int_least32_t my_int_least32_t, int_fast32_t my_int_fast32_t,
                 int64_t my_int64_t, int_least64_t my_int_least64_t,
-                /*int_fast64_t my_int_fast64_t,*/ intmax_t my_intmax_t,
+                int_fast64_t my_int_fast64_t, intmax_t my_intmax_t,
                 intptr_t my_intptr_t, float my_float, double my_double,
                 long double my_long_double, char my_char, _Bool my_bool);
    
@@ -43,10 +42,10 @@ int main(int argc, char **argv)
    _Bool my_bool = 1;
 
    param_test(my_short, my_int, my_long, my_long_long, my_int8_t,
-              my_int_least8_t, /*my_int_fast8_t,  */ my_int16_t,
-              my_int_least16_t,/* my_int_fast16_t,*/ my_int32_t,
-              my_int_least32_t,/* my_int_fast32_t,*/ my_int64_t,
-              my_int_least64_t,/* my_int_fast64_t,*/ my_intmax_t,
+              my_int_least8_t, my_int_fast8_t, my_int16_t,
+              my_int_least16_t, my_int_fast16_t, my_int32_t,
+              my_int_least32_t, my_int_fast32_t, my_int64_t,
+              my_int_least64_t, my_int_fast64_t, my_intmax_t,
               my_intptr_t, my_float, my_double, my_long_double, my_char,
               my_bool);