This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [PATCH, fortran] Interoperability with C int128_t types
This is the modified patch again. Thanks!
Sa
Index: gcc/gcc/fortran/gfortran.h
===================================================================
--- gcc.orig/gcc/fortran/gfortran.h
+++ gcc/gcc/fortran/gfortran.h
@@ -547,7 +547,7 @@ init_local_integer;
/* Used for keeping things in balanced binary trees. */
#define BBT_HEADER(self) int priority; struct self *left, *right
-#define NAMED_INTCST(a,b,c) a,
+#define NAMED_INTCST(a,b,c,d) a,
typedef enum
{
ISOFORTRANENV_INVALID = -1,
@@ -557,7 +557,7 @@ typedef enum
iso_fortran_env_symbol;
#undef NAMED_INTCST
-#define NAMED_INTCST(a,b,c) a,
+#define NAMED_INTCST(a,b,c,d) a,
#define NAMED_REALCST(a,b,c) a,
#define NAMED_CMPXCST(a,b,c) a,
#define NAMED_LOGCST(a,b,c) a,
Index: gcc/gcc/fortran/iso-c-binding.def
===================================================================
--- gcc.orig/gcc/fortran/iso-c-binding.def
+++ gcc/gcc/fortran/iso-c-binding.def
@@ -20,7 +20,7 @@ along with GCC; see the file COPYING3.
Fortran 2003 ISO_C_BINDING intrinsic module. */
#ifndef NAMED_INTCST
-# define NAMED_INTCST(a,b,c)
+# define NAMED_INTCST(a,b,c,d)
#endif
#ifndef NAMED_REALCST
@@ -42,44 +42,57 @@ along with GCC; see the file COPYING3.
/* The arguments to NAMED_*CST are:
-- an internal name
-- the symbol name in the module, as seen by Fortran code
- -- the value it has, for use in trans-types.c */
+ -- the value it has, for use in trans-types.c
+ -- the standard that supports this type */
-NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind)
+NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind, GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_SHORT, "c_short", \
- get_int_kind_from_node (short_integer_type_node))
+ get_int_kind_from_node (short_integer_type_node),
GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_LONG, "c_long", \
- get_int_kind_from_node (long_integer_type_node))
+ get_int_kind_from_node (long_integer_type_node),
GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_LONG_LONG, "c_long_long", \
- get_int_kind_from_node (long_long_integer_type_node))
+ get_int_kind_from_node (long_long_integer_type_node),
GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INTMAX_T, "c_intmax_t", \
- get_int_kind_from_node (intmax_type_node))
+ 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))
+ get_int_kind_from_node (ptr_type_node), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_SIZE_T, "c_size_t", \
- gfc_index_integer_kind)
+ gfc_index_integer_kind, GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_SIGNED_CHAR, "c_signed_char", \
- get_int_kind_from_node (signed_char_type_node))
+ 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))
-NAMED_INTCST (ISOCBINDING_INT16_T, "c_int16_t", get_int_kind_from_width
(16))
-NAMED_INTCST (ISOCBINDING_INT32_T, "c_int32_t", get_int_kind_from_width
(32))
-NAMED_INTCST (ISOCBINDING_INT64_T, "c_int64_t", get_int_kind_from_width
(64))
+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)
+/* GNU Extension. */
+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))
+ get_int_kind_from_minimal_width (8), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INT_LEAST16_T, "c_int_least16_t", \
- get_int_kind_from_minimal_width (16))
+ get_int_kind_from_minimal_width (16), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INT_LEAST32_T, "c_int_least32_t", \
- get_int_kind_from_minimal_width (32))
+ get_int_kind_from_minimal_width (32), GFC_STD_F2003)
NAMED_INTCST (ISOCBINDING_INT_LEAST64_T, "c_int_least64_t", \
- get_int_kind_from_minimal_width (64))
+ get_int_kind_from_minimal_width (64), 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)
-NAMED_INTCST (ISOCBINDING_INT_FAST16_T, "c_int_fast16_t", -2)
-NAMED_INTCST (ISOCBINDING_INT_FAST32_T, "c_int_fast32_t", -2)
-NAMED_INTCST (ISOCBINDING_INT_FAST64_T, "c_int_fast64_t", -2)
+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)
+/* GNU Extension. */
+NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t", -2,
GFC_STD_GNU)
NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \
get_real_kind_from_node (float_type_node))
Index: gcc/gcc/fortran/iso-fortran-env.def
===================================================================
--- gcc.orig/gcc/fortran/iso-fortran-env.def
+++ gcc/gcc/fortran/iso-fortran-env.def
@@ -22,15 +22,22 @@ along with GCC; see the file COPYING3.
/* The arguments to NAMED_INTCST are:
-- an internal name
-- the symbol name in the module, as seen by Fortran code
- -- the value it has */
+ -- the value it has
+ -- the standard that supports this type */
NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE,
"character_storage_size", \
- gfc_character_storage_size)
-NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit",
GFC_STDERR_UNIT_NUMBER)
-NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8)
-NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit",
GFC_STDIN_UNIT_NUMBER)
-NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END)
-NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR)
+ gfc_character_storage_size, GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit",
GFC_STDERR_UNIT_NUMBER, \
+ GFC_STD_F2003)
+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_IOSTAT_END, "iostat_end", LIBERROR_END, \
+ GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR, \
+ GFC_STD_F2003)
NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size",
\
- gfc_numeric_storage_size)
-NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit",
GFC_STDOUT_UNIT_NUMBER)
+ gfc_numeric_storage_size, GFC_STD_F2003)
+NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit",
GFC_STDOUT_UNIT_NUMBER, \
+ GFC_STD_F2003)
Index: gcc/gcc/fortran/module.c
===================================================================
--- gcc.orig/gcc/fortran/module.c
+++ gcc/gcc/fortran/module.c
@@ -4630,13 +4630,13 @@ use_iso_fortran_env_module (void)
int i;
intmod_sym symbol[] = {
-#define NAMED_INTCST(a,b,c) { a, b, 0 },
+#define NAMED_INTCST(a,b,c,d) { a, b, 0, d },
#include "iso-fortran-env.def"
#undef NAMED_INTCST
{ ISOFORTRANENV_INVALID, NULL, -1234 } };
i = 0;
-#define NAMED_INTCST(a,b,c) symbol[i++].value = c;
+#define NAMED_INTCST(a,b,c,d) symbol[i++].value = c;
#include "iso-fortran-env.def"
#undef NAMED_INTCST
Index: gcc/gcc/fortran/symbol.c
===================================================================
--- gcc.orig/gcc/fortran/symbol.c
+++ gcc/gcc/fortran/symbol.c
@@ -3740,6 +3740,15 @@ build_formal_args (gfc_symbol *new_proc_
gfc_current_ns = parent_ns;
}
+static int
+gnu_only_isocbinding (const char *name)
+{
+#define NAMED_INTCST(a,b,c,d) \
+ if (!strcmp (b, name)) \
+ return (d == GFC_STD_GNU);
+#include "iso-c-binding.def"
+ return 0;
+}
/* Generate the given set of C interoperable kind objects, or all
interoperable kinds. This function will only be given kind objects
@@ -3765,6 +3774,9 @@ generate_isocbinding_symbol (const char
char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
int index;
+ if (gfc_notification_std (GFC_STD_GNU) == FAILURE
+ && gnu_only_isocbinding (name))
+ return;
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
/* Already exists in this scope so don't re-add it.
@@ -3788,13 +3800,12 @@ generate_isocbinding_symbol (const char
switch (s)
{
-#define NAMED_INTCST(a,b,c) case a :
+#define NAMED_INTCST(a,b,c,d) case a :
#define NAMED_REALCST(a,b,c) case a :
#define NAMED_CMPXCST(a,b,c) case a :
#define NAMED_LOGCST(a,b,c) case a :
#define NAMED_CHARKNDCST(a,b,c) case a :
#include "iso-c-binding.def"
-
tmp_sym->value = gfc_int_expr (c_interop_kinds_table[s].value);
/* Initialize an integer constant expression node. */
Index: gcc/gcc/fortran/trans-types.c
===================================================================
--- gcc.orig/gcc/fortran/trans-types.c
+++ gcc/gcc/fortran/trans-types.c
@@ -219,7 +219,7 @@ void init_c_interop_kinds (void)
c_interop_kinds_table[i].f90_type = BT_UNKNOWN;
}
-#define NAMED_INTCST(a,b,c) \
+#define NAMED_INTCST(a,b,c,d) \
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;
Index: gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
===================================================================
--- /dev/null
+++ gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test1.f03
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f2003" }
+!
+! Note: int_fast*_t currently not supported.
+
+subroutine c_kind_int128_1
+ use, intrinsic :: iso_c_binding
+ implicit none
+
+ 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
+
+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
+
+end subroutine c_kind_int128_2
Index: gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
===================================================================
--- /dev/null
+++ gcc/gcc/testsuite/gfortran.dg/c_kind_int128_test2.f03
@@ -0,0 +1,15 @@
+! { dg-do run }
+! { dg-options "-std=gnu" }
+!
+! Note: int_fast*_t currently not supported.
+
+program c_kind_int128
+ use, intrinsic :: iso_c_binding
+ integer(c_int128_t) :: a
+ integer(c_int_least128_t) :: b
+! integer(c_int_fast128_t) :: c
+
+ if (sizeof (a) /= 16) call abort
+ if (sizeof (b) /= 16) call abort
+! if (sizeof (c) /= 16) call abort
+end program c_kind_int128