OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Francois-Xavier Coudert 2009-05-17 14:15:24 +00:00 committed by François-Xavier Coudert
parent 965cc3c3aa
commit e0a6661b79
10 changed files with 174 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
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

2
gcc/fortran/gfortran.h
View File

@ -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;

43
gcc/fortran/iso-c-binding.def
View File

@ -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)

14
gcc/fortran/iso-fortran-env.def
View File

@ -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)

91
gcc/fortran/trans-types.c
View File

@ -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". */

7
gcc/testsuite/ChangeLog
View File

@ -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

10
gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
View File

@ -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

2
gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
View File

@ -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

24
gcc/testsuite/gfortran.dg/c_kind_params.f90
View File

@ -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()

17
gcc/testsuite/gfortran.dg/c_kinds.c
View File

@ -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);