Unsigned constants for ISO_FORTRAN_ENV and ISO_C_BINDING.
gcc/fortran/ChangeLog: * dump-parse-tree.cc (get_c_type_name): Also handle BT_UNSIGNED. * gfortran.h (NAMED_UINTCST): Define before inclusion of iso-c-binding.def and iso-fortran-env.def. (gfc_get_uint_kind_from_width_isofortranenv): Prototype. * gfortran.texi: Mention new constants in iso_c_binding and iso_fortran_env. * iso-c-binding.def: Handle NAMED_UINTCST. Add c_unsigned, c_unsigned_short,c_unsigned_char, c_unsigned_long, c_unsigned_long_long, c_uintmax_t, c_uint8_t, c_uint16_t, c_uint32_t, c_uint64_t, c_uint128_t, c_uint_least8_t, c_uint_least16_t, c_uint_least32_t, c_uint_least64_t, c_uint_least128_t, c_uint_fast8_t, c_uint_fast16_t, c_uint_fast32_t, c_uint_fast64_t and c_uint_fast128_t. * iso-fortran-env.def: Handle NAMED_UINTCST. Add uint8, uint16, uint32 and uint64. * module.cc (parse_integer): Whitespace fix. (write_module): Whitespace fix. (NAMED_UINTCST): Define before inclusion of iso-fortran-evn.def and iso-fortran-env.def. * symbol.cc: Likewise. * trans-types.cc (get_unsigned_kind_from_node): New function. (get_uint_kind_from_name): New function. (gfc_get_uint_kind_from_width_isofortranenv): New function. (get_uint_kind_from_width): New function. (gfc_init_kinds): Initialize gfc_c_uint_kind. gcc/testsuite/ChangeLog: * gfortran.dg/unsigned_36.f90: New test.
This commit is contained in:
Thomas Koenig
parent
a9173a50e7
commit
d09131eea0
9 changed files with 244 additions and 8 deletions
|
|
@ -3867,7 +3867,8 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre,
|
|||
*asterisk = false;
|
||||
*post = "";
|
||||
*type_name = "<error>";
|
||||
if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX)
|
||||
if (ts->type == BT_REAL || ts->type == BT_INTEGER || ts->type == BT_COMPLEX
|
||||
|| ts->type == BT_UNSIGNED)
|
||||
{
|
||||
if (ts->is_c_interop && ts->interop_kind)
|
||||
ret = T_OK;
|
||||
|
|
@ -3895,7 +3896,16 @@ get_c_type_name (gfc_typespec *ts, gfc_array_spec *as, const char **pre,
|
|||
*type_name = "__GFORTRAN_DOUBLE_COMPLEX";
|
||||
else if (strcmp (*type_name, "long_double_complex") == 0)
|
||||
*type_name = "__GFORTRAN_LONG_DOUBLE_COMPLEX";
|
||||
|
||||
else if (strcmp (*type_name, "unsigned") == 0)
|
||||
*type_name = "unsigned int";
|
||||
else if (strcmp (*type_name, "unsigned_char") == 0)
|
||||
*type_name = "unsigned char";
|
||||
else if (strcmp (*type_name, "unsigned_short") == 0)
|
||||
*type_name = "unsigned short int";
|
||||
else if (strcmp (*type_name, "unsigned_long") == 0)
|
||||
*type_name = "unsigned long int";
|
||||
else if (strcmp (*type_name, "unsigned_long long") == 0)
|
||||
*type_name = "unsigned long long int";
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -754,6 +754,7 @@ enum gfc_param_spec_type
|
|||
#define BBT_HEADER(self) int priority; struct self *left, *right
|
||||
|
||||
#define NAMED_INTCST(a,b,c,d) a,
|
||||
#define NAMED_UINTCST(a,b,c,d) a,
|
||||
#define NAMED_KINDARRAY(a,b,c,d) a,
|
||||
#define NAMED_FUNCTION(a,b,c,d) a,
|
||||
#define NAMED_SUBROUTINE(a,b,c,d) a,
|
||||
|
|
@ -765,6 +766,7 @@ enum iso_fortran_env_symbol
|
|||
ISOFORTRANENV_LAST, ISOFORTRANENV_NUMBER = ISOFORTRANENV_LAST
|
||||
};
|
||||
#undef NAMED_INTCST
|
||||
#undef NANED_UINTCST
|
||||
#undef NAMED_KINDARRAY
|
||||
#undef NAMED_FUNCTION
|
||||
#undef NAMED_SUBROUTINE
|
||||
|
|
@ -779,6 +781,7 @@ enum iso_fortran_env_symbol
|
|||
#define DERIVED_TYPE(a,b,c) a,
|
||||
#define NAMED_FUNCTION(a,b,c,d) a,
|
||||
#define NAMED_SUBROUTINE(a,b,c,d) a,
|
||||
#define NAMED_UINTCST(a,b,c,d) a,
|
||||
enum iso_c_binding_symbol
|
||||
{
|
||||
ISOCBINDING_INVALID = -1,
|
||||
|
|
@ -795,6 +798,7 @@ enum iso_c_binding_symbol
|
|||
#undef DERIVED_TYPE
|
||||
#undef NAMED_FUNCTION
|
||||
#undef NAMED_SUBROUTINE
|
||||
#undef NAMED_UINTCST
|
||||
|
||||
enum intmod_id
|
||||
{
|
||||
|
|
@ -3503,6 +3507,7 @@ extern bool gfc_seen_div0;
|
|||
/* trans-types.cc */
|
||||
int gfc_validate_kind (bt, int, bool);
|
||||
int gfc_get_int_kind_from_width_isofortranenv (int size);
|
||||
int gfc_get_uint_kind_from_width_isofortranenv (int size);
|
||||
int gfc_get_real_kind_from_width_isofortranenv (int size);
|
||||
tree gfc_get_union_type (gfc_symbol *);
|
||||
tree gfc_get_derived_type (gfc_symbol * derived, int codimen = 0);
|
||||
|
|
@ -3516,6 +3521,7 @@ extern int gfc_default_character_kind;
|
|||
extern int gfc_default_logical_kind;
|
||||
extern int gfc_default_complex_kind;
|
||||
extern int gfc_c_int_kind;
|
||||
extern int gfc_c_uint_kind;
|
||||
extern int gfc_c_intptr_kind;
|
||||
extern int gfc_atomic_int_kind;
|
||||
extern int gfc_atomic_logical_kind;
|
||||
|
|
|
|||
|
|
@ -2796,7 +2796,21 @@ As of now, the following intrinsics take unsigned arguments:
|
|||
@item @code{MAXVAL} and @code{MINVAL}
|
||||
@item @code{MAXLOC} and @code{MINLOC}.
|
||||
@end itemize
|
||||
This list will grow in the near future.
|
||||
The following constants have been added to the intrinsic
|
||||
@code{ISO_C_BINDING} module: @code{c_unsigned},
|
||||
@code{c_unsigned_short}, @code{c_unsigned_char},
|
||||
@code{c_unsigned_long}, @code{c_unsigned_long_long},
|
||||
@code{c_uintmax_t}, @code{c_uint8_t}, @code{c_uint16_t},
|
||||
@code{c_uint32_t}, @code{c_uint64_t}, @code{c_uint128_t},
|
||||
@code{c_uint_fast8_t}, @code{c_uint_fast16_t}, @code{c_uint_fast32_t},
|
||||
@code{c_uint_fast64_t}, @code{c_uint_fast128_t},
|
||||
@code{c_uint_least8_t}, @code{c_uint_least16_t}, @code{c_uint_least32_t},
|
||||
@code{c_uint_least64_t} and @code{c_uint_least128_t}.
|
||||
|
||||
The following constants have been added to the intrinsic
|
||||
@code{ISO_FORTRAN_ENV} module: @code{uint8}, @code{uint16},
|
||||
@code{uint32} and @code{uint64}.
|
||||
|
||||
@c ---------------------------------------------------------------------
|
||||
@c ---------------------------------------------------------------------
|
||||
@c Mixed-Language Programming
|
||||
|
|
|
|||
|
|
@ -47,6 +47,10 @@ along with GCC; see the file COPYING3. If not see
|
|||
# define NAMED_SUBROUTINE(a,b,c,d)
|
||||
#endif
|
||||
|
||||
#ifndef NAMED_UINTCST
|
||||
# define NAMED_UINTCST(a,b,c,d)
|
||||
#endif
|
||||
|
||||
/* The arguments to NAMED_*CST are:
|
||||
-- an internal name
|
||||
-- the symbol name in the module, as seen by Fortran code
|
||||
|
|
@ -108,6 +112,62 @@ NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", \
|
|||
NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t",
|
||||
get_int_kind_from_width (128), GFC_STD_GNU)
|
||||
|
||||
/* UNSIGNED. */
|
||||
NAMED_UINTCST (ISOCBINDING_UINT, "c_unsigned", gfc_c_uint_kind, \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_USHORT, "c_unsigned_short", \
|
||||
get_unsigned_kind_from_node (short_unsigned_type_node), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UCHAR, "c_unsigned_char", \
|
||||
get_unsigned_kind_from_node (unsigned_char_type_node), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_ULONG, "c_unsigned_long", \
|
||||
get_unsigned_kind_from_node (long_unsigned_type_node), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_ULONGLONG, "c_unsigned_long_long", \
|
||||
get_unsigned_kind_from_node (long_long_unsigned_type_node), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINTMAX_T, "c_uintmax_t", \
|
||||
get_uint_kind_from_name (UINTMAX_TYPE), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT8_T, "c_uint8_t", \
|
||||
get_uint_kind_from_name (UINT8_TYPE), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT16_T, "c_uint16_t", \
|
||||
get_uint_kind_from_name (UINT16_TYPE), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT32_T, "c_uint32_t", \
|
||||
get_uint_kind_from_name (UINT32_TYPE), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT64_T, "c_uint64_t", \
|
||||
get_uint_kind_from_name (UINT64_TYPE), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT128_T, "c_uint128_t", \
|
||||
get_uint_kind_from_width (128), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_LEAST8_T, "c_uint_least8_t", \
|
||||
get_uint_kind_from_name (UINT_LEAST8_TYPE), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_LEAST16_T, "c_uint_least16_t", \
|
||||
get_uint_kind_from_name (UINT_LEAST16_TYPE), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_LEAST32_T, "c_uint_least32_t", \
|
||||
get_uint_kind_from_name (UINT_LEAST32_TYPE),\
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_LEAST64_T, "c_uint_least64_t", \
|
||||
get_uint_kind_from_name (UINT_LEAST64_TYPE),\
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_LEAST128_T, "c_uint_least128_t", \
|
||||
get_uint_kind_from_width (128), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_FAST8_T, "c_uint_fast8_t", \
|
||||
get_uint_kind_from_name (UINT_FAST8_TYPE), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_FAST16_T, "c_uint_fast16_t", \
|
||||
get_uint_kind_from_name (UINT_FAST16_TYPE), \
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_FAST32_T, "c_uint_fast32_t", \
|
||||
get_uint_kind_from_name (UINT_FAST32_TYPE),\
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_FAST64_T, "c_uint_fast64_t", \
|
||||
get_uint_kind_from_name (UINT_FAST64_TYPE),\
|
||||
GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOCBINDING_UINT_FAST128_T, "c_uint_fast128_t", \
|
||||
get_uint_kind_from_width (128), GFC_STD_UNSIGNED)
|
||||
|
||||
NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \
|
||||
get_real_kind_from_node (float_type_node), GFC_STD_F2003)
|
||||
NAMED_REALCST (ISOCBINDING_DOUBLE, "c_double", \
|
||||
|
|
@ -197,6 +257,7 @@ NAMED_FUNCTION (ISOCBINDING_C_SIZEOF, "c_sizeof", \
|
|||
GFC_ISYM_C_SIZEOF, GFC_STD_F2008)
|
||||
|
||||
#undef NAMED_INTCST
|
||||
#undef NAMED_UINTCST
|
||||
#undef NAMED_REALCST
|
||||
#undef NAMED_CMPXCST
|
||||
#undef NAMED_LOGCST
|
||||
|
|
|
|||
|
|
@ -23,6 +23,10 @@ along with GCC; see the file COPYING3. If not see
|
|||
# define NAMED_INTCST(a,b,c,d)
|
||||
#endif
|
||||
|
||||
#ifndef NAMED_UINTCST
|
||||
# define NAMED_UINTCST(a,b,c,d)
|
||||
#endif
|
||||
|
||||
#ifndef NAMED_KINDARRAY
|
||||
# define NAMED_KINDARRAY(a,b,c,d)
|
||||
#endif
|
||||
|
|
@ -99,7 +103,14 @@ NAMED_INTCST (ISOFORTRANENV_FILE_STAT_FAILED_IMAGE, "stat_failed_image", \
|
|||
GFC_STAT_FAILED_IMAGE, GFC_STD_F2018)
|
||||
NAMED_INTCST (ISOFORTRANENV_FILE_STAT_UNLOCKED, "stat_unlocked", \
|
||||
GFC_STAT_UNLOCKED, GFC_STD_F2008)
|
||||
|
||||
NAMED_UINTCST (ISOFORTRANENV_UINT8, "uint8", \
|
||||
gfc_get_uint_kind_from_width_isofortranenv (8), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOFORTRANENV_UINT16, "uint16", \
|
||||
gfc_get_uint_kind_from_width_isofortranenv (16), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOFORTRANENV_UINT32, "uint32", \
|
||||
gfc_get_uint_kind_from_width_isofortranenv (32), GFC_STD_UNSIGNED)
|
||||
NAMED_UINTCST (ISOFORTRANENV_UINT64, "uint64", \
|
||||
gfc_get_uint_kind_from_width_isofortranenv (64), GFC_STD_UNSIGNED)
|
||||
|
||||
/* The arguments to NAMED_KINDARRAY are:
|
||||
-- an internal name
|
||||
|
|
@ -144,6 +155,7 @@ NAMED_DERIVED_TYPE (ISOFORTRAN_TEAM_TYPE, "team_type", \
|
|||
: gfc_default_integer_kind, GFC_STD_F2018)
|
||||
|
||||
#undef NAMED_INTCST
|
||||
#undef NAMED_UINTCST
|
||||
#undef NAMED_KINDARRAY
|
||||
#undef NAMED_FUNCTION
|
||||
#undef NAMED_SUBROUTINE
|
||||
|
|
|
|||
|
|
@ -1353,7 +1353,7 @@ parse_integer (int c)
|
|||
atom_int = 10 * atom_int + c - '0';
|
||||
}
|
||||
|
||||
atom_int *= sign;
|
||||
atom_int *= sign;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -6346,7 +6346,7 @@ write_module (void)
|
|||
|
||||
/* Initialize the column counter. */
|
||||
module_column = 1;
|
||||
|
||||
|
||||
/* Write the operator interfaces. */
|
||||
mio_lparen ();
|
||||
|
||||
|
|
@ -6780,7 +6780,12 @@ import_iso_c_binding_module (void)
|
|||
not_in_std = (gfc_option.allow_std & d) == 0; \
|
||||
name = b; \
|
||||
break;
|
||||
#define NAMED_REALCST(a,b,c,d) \
|
||||
#define NAMED_UINTCST(a,b,c,d) \
|
||||
case a: \
|
||||
not_in_std = (gfc_option.allow_std & d) == 0; \
|
||||
name = b; \
|
||||
break;
|
||||
#define NAMED_REALCST(a,b,c,d) \
|
||||
case a: \
|
||||
not_in_std = (gfc_option.allow_std & d) == 0; \
|
||||
name = b; \
|
||||
|
|
@ -6867,7 +6872,12 @@ import_iso_c_binding_module (void)
|
|||
if ((gfc_option.allow_std & d) == 0) \
|
||||
continue; \
|
||||
break;
|
||||
#define NAMED_REALCST(a,b,c,d) \
|
||||
#define NAMED_UINTCST(a,b,c,d) \
|
||||
case a: \
|
||||
if ((gfc_option.allow_std & d) == 0) \
|
||||
continue; \
|
||||
break;
|
||||
#define NAMED_REALCST(a,b,c,d) \
|
||||
case a: \
|
||||
if ((gfc_option.allow_std & d) == 0) \
|
||||
continue; \
|
||||
|
|
@ -7101,6 +7111,7 @@ use_iso_fortran_env_module (void)
|
|||
|
||||
intmod_sym symbol[] = {
|
||||
#define NAMED_INTCST(a,b,c,d) { a, b, 0, d },
|
||||
#define NAMED_UINTCST(a,b,c,d) { a, b, 0, d },
|
||||
#define NAMED_KINDARRAY(a,b,c,d) { a, b, 0, d },
|
||||
#define NAMED_DERIVED_TYPE(a,b,c,d) { a, b, 0, d },
|
||||
#define NAMED_FUNCTION(a,b,c,d) { a, b, c, d },
|
||||
|
|
@ -7110,6 +7121,9 @@ use_iso_fortran_env_module (void)
|
|||
|
||||
i = 0;
|
||||
#define NAMED_INTCST(a,b,c,d) symbol[i++].value = c;
|
||||
#include "iso-fortran-env.def"
|
||||
|
||||
#define NAMED_UINTCST(a,b,c,d) symbol[i++].value = c;
|
||||
#include "iso-fortran-env.def"
|
||||
|
||||
/* Generate the symbol for the module itself. */
|
||||
|
|
@ -7167,6 +7181,15 @@ use_iso_fortran_env_module (void)
|
|||
INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
|
||||
break;
|
||||
|
||||
#define NAMED_UINTCST(a,b,c,d) \
|
||||
case a:
|
||||
#include "iso-fortran-env.def"
|
||||
create_int_parameter (u->local_name[0] ? u->local_name
|
||||
: u->use_name,
|
||||
symbol[i].value, mod,
|
||||
INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
|
||||
break;
|
||||
|
||||
#define NAMED_KINDARRAY(a,b,KINDS,d) \
|
||||
case a:\
|
||||
expr = gfc_get_array_expr (BT_INTEGER, \
|
||||
|
|
@ -7232,6 +7255,13 @@ use_iso_fortran_env_module (void)
|
|||
INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
|
||||
break;
|
||||
|
||||
#define NAMED_UINTCST(a,b,c,d) \
|
||||
case a:
|
||||
#include "iso-fortran-env.def"
|
||||
create_int_parameter (symbol[i].name, symbol[i].value, mod,
|
||||
INTMOD_ISO_FORTRAN_ENV, symbol[i].id);
|
||||
break;
|
||||
|
||||
#define NAMED_KINDARRAY(a,b,KINDS,d) \
|
||||
case a:\
|
||||
expr = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, \
|
||||
|
|
|
|||
|
|
@ -4925,6 +4925,12 @@ std_for_isocbinding_symbol (int id)
|
|||
#include "iso-c-binding.def"
|
||||
#undef NAMED_INTCST
|
||||
|
||||
#define NAMED_UINTCST(a,b,c,d) \
|
||||
case a:\
|
||||
return d;
|
||||
#include "iso-c-binding.def"
|
||||
#undef NAMED_UINTCST
|
||||
|
||||
#define NAMED_FUNCTION(a,b,c,d) \
|
||||
case a:\
|
||||
return d;
|
||||
|
|
@ -5032,6 +5038,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
|
|||
{
|
||||
|
||||
#define NAMED_INTCST(a,b,c,d) case a :
|
||||
#define NAMED_UINTCST(a,b,c,d) case a :
|
||||
#define NAMED_REALCST(a,b,c,d) case a :
|
||||
#define NAMED_CMPXCST(a,b,c,d) case a :
|
||||
#define NAMED_LOGCST(a,b,c) case a :
|
||||
|
|
|
|||
|
|
@ -119,6 +119,7 @@ int gfc_default_character_kind;
|
|||
int gfc_default_logical_kind;
|
||||
int gfc_default_complex_kind;
|
||||
int gfc_c_int_kind;
|
||||
int gfc_c_uint_kind;
|
||||
int gfc_c_intptr_kind;
|
||||
int gfc_atomic_int_kind;
|
||||
int gfc_atomic_logical_kind;
|
||||
|
|
@ -226,6 +227,26 @@ get_int_kind_from_name (const char *name)
|
|||
return get_int_kind_from_node (get_typenode_from_name (name));
|
||||
}
|
||||
|
||||
static int
|
||||
get_unsigned_kind_from_node (tree type)
|
||||
{
|
||||
int i;
|
||||
|
||||
if (!type)
|
||||
return -2;
|
||||
|
||||
for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
|
||||
if (gfc_unsigned_kinds[i].bit_size == TYPE_PRECISION (type))
|
||||
return gfc_unsigned_kinds[i].kind;
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
static int
|
||||
get_uint_kind_from_name (const char *name)
|
||||
{
|
||||
return get_unsigned_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:
|
||||
|
|
@ -248,6 +269,26 @@ gfc_get_int_kind_from_width_isofortranenv (int size)
|
|||
return -1;
|
||||
}
|
||||
|
||||
/* Same, but for unsigned. */
|
||||
|
||||
int
|
||||
gfc_get_uint_kind_from_width_isofortranenv (int size)
|
||||
{
|
||||
int i;
|
||||
|
||||
/* Look for a kind with matching storage size. */
|
||||
for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
|
||||
if (gfc_unsigned_kinds[i].bit_size == size)
|
||||
return gfc_unsigned_kinds[i].kind;
|
||||
|
||||
/* Look for a kind with larger storage size. */
|
||||
for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
|
||||
if (gfc_unsigned_kinds[i].bit_size > size)
|
||||
return -2;
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
|
||||
/* Get the kind number corresponding to a real of a given storage size.
|
||||
If two real's have the same storage size, then choose the real with
|
||||
|
|
@ -312,6 +353,18 @@ get_int_kind_from_minimal_width (int size)
|
|||
return -2;
|
||||
}
|
||||
|
||||
static int
|
||||
get_uint_kind_from_width (int size)
|
||||
{
|
||||
int i;
|
||||
|
||||
for (i = 0; gfc_unsigned_kinds[i].kind != 0; i++)
|
||||
if (gfc_integer_kinds[i].bit_size == size)
|
||||
return gfc_integer_kinds[i].kind;
|
||||
|
||||
return -2;
|
||||
}
|
||||
|
||||
|
||||
/* Generate the CInteropKind_t objects for the C interoperable
|
||||
kinds. */
|
||||
|
|
@ -334,6 +387,10 @@ gfc_init_c_interop_kinds (void)
|
|||
strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
|
||||
c_interop_kinds_table[a].f90_type = BT_INTEGER; \
|
||||
c_interop_kinds_table[a].value = c;
|
||||
#define NAMED_UINTCST(a,b,c,d) \
|
||||
strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
|
||||
c_interop_kinds_table[a].f90_type = BT_UNSIGNED; \
|
||||
c_interop_kinds_table[a].value = c;
|
||||
#define NAMED_REALCST(a,b,c,d) \
|
||||
strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
|
||||
c_interop_kinds_table[a].f90_type = BT_REAL; \
|
||||
|
|
@ -746,6 +803,9 @@ gfc_init_kinds (void)
|
|||
/* Pick a kind the same size as the C "int" type. */
|
||||
gfc_c_int_kind = INT_TYPE_SIZE / 8;
|
||||
|
||||
/* UNSIGNED has the same as INT. */
|
||||
gfc_c_uint_kind = gfc_c_int_kind;
|
||||
|
||||
/* Choose atomic kinds to match C's int. */
|
||||
gfc_atomic_int_kind = gfc_c_int_kind;
|
||||
gfc_atomic_logical_kind = gfc_c_int_kind;
|
||||
|
|
|
|||
36
gcc/testsuite/gfortran.dg/unsigned_36.f90
Normal file
36
gcc/testsuite/gfortran.dg/unsigned_36.f90
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
! { dg-do compile }
|
||||
! { dg-options "-funsigned" }
|
||||
module use_c_binding
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
unsigned(c_unsigned), bind(c) :: a
|
||||
unsigned(c_unsigned_short), bind(c) :: b
|
||||
unsigned(c_unsigned_char), bind(c) :: c
|
||||
unsigned(c_unsigned_long), bind(c) :: d
|
||||
unsigned(c_unsigned_long_long), bind(c) :: e
|
||||
unsigned(c_uintmax_t), bind(c) :: f
|
||||
unsigned(c_uint8_t), bind(c) :: u8
|
||||
unsigned(c_uint16_t), bind(c) :: u16
|
||||
unsigned(c_uint32_t), bind(c) :: u32
|
||||
unsigned(c_uint64_t), bind(c) :: u64
|
||||
unsigned(c_uint_fast8_t), bind(c) :: f8
|
||||
unsigned(c_uint_fast16_t), bind(c) :: f16
|
||||
unsigned(c_uint_fast32_t), bind(c) :: f32
|
||||
unsigned(c_uint_fast64_t), bind(c) :: f64
|
||||
unsigned(c_uint_least8_t), bind(c) :: l8
|
||||
unsigned(c_uint_least16_t), bind(c) :: l16
|
||||
unsigned(c_uint_least32_t), bind(c) :: l32
|
||||
unsigned(c_uint_least64_t), bind(c) :: l64
|
||||
integer, parameter :: c_128 = c_uint128_t
|
||||
integer, parameter :: fast_128 = c_uint_fast128_t
|
||||
integer, parameter :: least_128 = c_uint_least128_t
|
||||
end module use_c_binding
|
||||
|
||||
program memain
|
||||
use use_c_binding
|
||||
use iso_fortran_env
|
||||
unsigned(uint8) :: a8
|
||||
unsigned(uint16) :: a16
|
||||
unsigned(uint32) :: a32
|
||||
unsigned(uint64) :: a64
|
||||
end program memain
|
||||
Loading…
Add table
Reference in a new issue