+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
/* 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;
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)
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, \
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)
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)
{
return new_type;
}
+
#if 0
/* Return the bit size of the C "size_t". */
+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
! { 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
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
! { 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
! 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
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
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()
#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);
_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);
projects / gcc.git / commitdiff