This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] Add c_float128{,_complex} as GNU extension to ISO_C_BINDING
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc patches <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Wed, 28 Sep 2011 16:28:24 +0200
- Subject: [Patch, Fortran] Add c_float128{,_complex} as GNU extension to ISO_C_BINDING
This patch makes the GCC extension __float128 (_Complex) available in
the C bindings via C_FLOAT128 and C_FLOAT128_COMPLEX.
Additionally, I have improved the diagnostic for explicitly use
associating -std= versioned symbols. And I have finally added the
iso*.def files to the makefile dependencies.
As usual, with -std=f2008, the GNU extensions are not loaded. I have
also updated the documentation.
OK for the trunk?
Tobias
PS: If you think that C_FLOAT128/C_FLOAT128_COMPLEX are bad names for
C's __float128, please speak up before gfortran - and other compilers
implement it. (At least one vendor is implementing __float128 support
and plans to modify ISO_C_BINDING.) The proper name would be
C___FLOAT128, but that looks awkward!
2011-09-28 Tobias Burnus <burnus@net-b.de>
* Make-lang.in (F95_PARSER_OBJS, GFORTRAN_TRANS_DEPS): Add
dependency on iso-c-binding.def and iso-fortran-env.def.
* module.c (import_iso_c_binding_module): Add error when
explicitly importing a nonstandard symbol; extend standard-
depending loading.
* iso-c-binding.def: Add c_float128 and c_float128_complex
integer parameters (for -std=gnu).
* intrinsic.texi (ISO_C_Binding): Document them.
* symbol.c (generate_isocbinding_symbol): Change macros
to ignore GFC_STD_* data.
* trans-types.c (gfc_init_c_interop_kinds): Ditto; make
nonstatic and renamed from "init_c_interop_kinds".
(gfc_init_kinds): Don't call it
* trans-types.h (gfc_init_c_interop_kinds): Add prototype.
* f95-lang.c (gfc_init_decl_processing): Call it.
2011-09-28 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/iso_c_binding_param_1.f90: New.
* gfortran.dg/iso_c_binding_param_2.f90: New.
* gfortran.dg/c_sizeof_2.f90: Update dg-error.
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 0816458..b766da6 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -329,14 +329,16 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/libgfortran.h \
fortran/parse.h fortran/arith.h fortran/target-memory.h \
$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \
$(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \
- $(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H)
+ $(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) \
+ fortran/iso-c-binding.def fortran/iso-fortran-env.def
fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h
GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/libgfortran.h \
fortran/intrinsic.h fortran/trans-array.h \
fortran/trans-const.h fortran/trans-const.h fortran/trans.h \
fortran/trans-stmt.h fortran/trans-types.h \
- $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H)
+ $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H) \
+ fortran/iso-c-binding.def fortran/iso-fortran-env.def
fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
gt-fortran-f95-lang.h gtype-fortran.h $(CGRAPH_H) $(TARGET_H) fortran/cpp.h \
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 648831f..8f8dd7d 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -595,6 +595,7 @@ gfc_init_decl_processing (void)
/* Set up F95 type nodes. */
gfc_init_kinds ();
gfc_init_types ();
+ gfc_init_c_interop_kinds ();
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 54e0b20..1bd5ec3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -610,8 +610,8 @@ iso_fortran_env_symbol;
#undef NAMED_DERIVED_TYPE
#define NAMED_INTCST(a,b,c,d) a,
-#define NAMED_REALCST(a,b,c) a,
-#define NAMED_CMPXCST(a,b,c) a,
+#define NAMED_REALCST(a,b,c,d) a,
+#define NAMED_CMPXCST(a,b,c,d) a,
#define NAMED_LOGCST(a,b,c) a,
#define NAMED_CHARKNDCST(a,b,c) a,
#define NAMED_CHARCST(a,b,c) a,
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 9adeeab..a093bec 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -13006,7 +13006,9 @@ type default integer, which can be used as KIND type parameters.
In addition to the integer named constants required by the Fortran 2003
standard, GNU Fortran provides as an extension named constants for the
128-bit integer types supported by the C compiler: @code{C_INT128_T,
-C_INT_LEAST128_T, C_INT_FAST128_T}.
+C_INT_LEAST128_T, C_INT_FAST128_T}. Furthermore, if @code{__float} is
+supported in C, the named constants @code{C_FLOAT128, C_FLOAT128_COMPLEX}
+are defined.
@multitable @columnfractions .15 .35 .35 .35
@item Fortran Type @tab Named constant @tab C type @tab Extension
@@ -13036,9 +13038,11 @@ C_INT_LEAST128_T, C_INT_FAST128_T}.
@item @code{REAL} @tab @code{C_FLOAT} @tab @code{float}
@item @code{REAL} @tab @code{C_DOUBLE} @tab @code{double}
@item @code{REAL} @tab @code{C_LONG_DOUBLE} @tab @code{long double}
+@item @code{REAL} @tab @code{C_FLOAT128} @tab @code{__float128} @tab Ext.
@item @code{COMPLEX}@tab @code{C_FLOAT_COMPLEX} @tab @code{float _Complex}
@item @code{COMPLEX}@tab @code{C_DOUBLE_COMPLEX}@tab @code{double _Complex}
@item @code{COMPLEX}@tab @code{C_LONG_DOUBLE_COMPLEX}@tab @code{long double _Complex}
+@item @code{REAL} @tab @code{C_FLOAT128_COMPLEX} @tab @code{__float128 _Complex} @tab Ext.
@item @code{LOGICAL}@tab @code{C_BOOL} @tab @code{_Bool}
@item @code{CHARACTER}@tab @code{C_CHAR} @tab @code{char}
@end multitable
diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def
index bea8306..f8673b9 100644
--- a/gcc/fortran/iso-c-binding.def
+++ b/gcc/fortran/iso-c-binding.def
@@ -24,11 +24,11 @@ along with GCC; see the file COPYING3. If not see
#endif
#ifndef NAMED_REALCST
-# define NAMED_REALCST(a,b,c)
+# define NAMED_REALCST(a,b,c,d)
#endif
#ifndef NAMED_CMPXCST
-# define NAMED_CMPXCST(a,b,c)
+# define NAMED_CMPXCST(a,b,c,d)
#endif
#ifndef NAMED_LOGCST
@@ -103,17 +103,25 @@ NAMED_INTCST (ISOCBINDING_INT_FAST128_T, "c_int_fast128_t",
get_int_kind_from_width (128), GFC_STD_GNU)
NAMED_REALCST (ISOCBINDING_FLOAT, "c_float", \
- get_real_kind_from_node (float_type_node))
+ get_real_kind_from_node (float_type_node), GFC_STD_F2003)
NAMED_REALCST (ISOCBINDING_DOUBLE, "c_double", \
- get_real_kind_from_node (double_type_node))
+ get_real_kind_from_node (double_type_node), GFC_STD_F2003)
NAMED_REALCST (ISOCBINDING_LONG_DOUBLE, "c_long_double", \
- get_real_kind_from_node (long_double_type_node))
+ get_real_kind_from_node (long_double_type_node), GFC_STD_F2003)
+NAMED_REALCST (ISOCBINDING_FLOAT128, "c_float128", \
+ float128_type_node == NULL_TREE \
+ ? -4 : get_real_kind_from_node (float128_type_node), \
+ GFC_STD_GNU)
NAMED_CMPXCST (ISOCBINDING_FLOAT_COMPLEX, "c_float_complex", \
- get_real_kind_from_node (float_type_node))
+ get_real_kind_from_node (float_type_node), GFC_STD_F2003)
NAMED_CMPXCST (ISOCBINDING_DOUBLE_COMPLEX, "c_double_complex", \
- get_real_kind_from_node (double_type_node))
+ get_real_kind_from_node (double_type_node), GFC_STD_F2003)
NAMED_CMPXCST (ISOCBINDING_LONG_DOUBLE_COMPLEX, "c_long_double_complex", \
- get_real_kind_from_node (long_double_type_node))
+ get_real_kind_from_node (long_double_type_node), GFC_STD_F2003)
+NAMED_CMPXCST (ISOCBINDING_FLOAT128_COMPLEX, "c_float128_complex", \
+ float128_type_node == NULL_TREE \
+ ? -4 : get_real_kind_from_node (float128_type_node), \
+ GFC_STD_GNU)
NAMED_LOGCST (ISOCBINDING_BOOL, "c_bool", \
get_int_kind_from_width (BOOL_TYPE_SIZE))
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index b29ba4b..c142852 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5348,8 +5348,53 @@ import_iso_c_binding_module (void)
for (u = gfc_rename_list; u; u = u->next)
if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0)
{
+ bool not_in_std;
+ const char *name;
u->found = 1;
found = true;
+
+ switch (i)
+ {
+#define NAMED_FUNCTION(a,b,c,d) \
+ case a: \
+ not_in_std = (gfc_option.allow_std & d) == 0; \
+ name = b; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_FUNCTION
+#define NAMED_INTCST(a,b,c,d) \
+ case a: \
+ not_in_std = (gfc_option.allow_std & d) == 0; \
+ name = b; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_INTCST
+#define NAMED_REALCST(a,b,c,d) \
+ case a: \
+ not_in_std = (gfc_option.allow_std & d) == 0; \
+ name = b; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_REALCST
+#define NAMED_CMPXCST(a,b,c,d) \
+ case a: \
+ not_in_std = (gfc_option.allow_std & d) == 0; \
+ name = b; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_CMPXCST
+ default:
+ not_in_std = false;
+ name = "";
+ }
+
+ if (not_in_std)
+ {
+ gfc_error ("The symbol '%s', referenced at %C, is not "
+ "in the selected standard", name);
+ continue;
+ }
+
switch (i)
{
#define NAMED_FUNCTION(a,b,c,d) \
@@ -5372,23 +5417,59 @@ import_iso_c_binding_module (void)
}
if (!found && !only_flag)
- switch (i)
- {
+ {
+ /* Skip, if the symbol is not in the enabled standard. */
+ switch (i)
+ {
+#define NAMED_FUNCTION(a,b,c,d) \
+ case a: \
+ if ((gfc_option.allow_std & d) == 0) \
+ continue; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_FUNCTION
+
+#define NAMED_INTCST(a,b,c,d) \
+ case a: \
+ if ((gfc_option.allow_std & d) == 0) \
+ continue; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_INTCST
+#define NAMED_REALCST(a,b,c,d) \
+ case a: \
+ if ((gfc_option.allow_std & d) == 0) \
+ continue; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_REALCST
+#define NAMED_CMPXCST(a,b,c,d) \
+ case a: \
+ if ((gfc_option.allow_std & d) == 0) \
+ continue; \
+ break;
+#include "iso-c-binding.def"
+#undef NAMED_CMPXCST
+ default:
+ ; /* Not GFC_STD_* versioned. */
+ }
+
+ switch (i)
+ {
#define NAMED_FUNCTION(a,b,c,d) \
- case a: \
- if ((gfc_option.allow_std & d) == 0) \
- continue; \
- create_intrinsic_function (b, (gfc_isym_id) c, \
- iso_c_module_name, \
- INTMOD_ISO_C_BINDING); \
+ case a: \
+ create_intrinsic_function (b, (gfc_isym_id) c, \
+ iso_c_module_name, \
+ INTMOD_ISO_C_BINDING); \
break;
#include "iso-c-binding.def"
#undef NAMED_FUNCTION
- default:
- generate_isocbinding_symbol (iso_c_module_name,
- (iso_c_binding_symbol) i, NULL);
- }
+ default:
+ generate_isocbinding_symbol (iso_c_module_name,
+ (iso_c_binding_symbol) i, NULL);
+ }
+ }
}
for (u = gfc_rename_list; u; u = u->next)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 25186c9..5a01fa0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4335,8 +4335,8 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
{
#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_REALCST(a,b,c,d) case a :
+#define NAMED_CMPXCST(a,b,c,d) case a :
#define NAMED_LOGCST(a,b,c) case a :
#define NAMED_CHARKNDCST(a,b,c) case a :
#include "iso-c-binding.def"
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index aa8e43b..4c5990e 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -298,8 +298,8 @@ get_int_kind_from_minimal_width (int size)
/* Generate the CInteropKind_t objects for the C interoperable
kinds. */
-static
-void init_c_interop_kinds (void)
+void
+gfc_init_c_interop_kinds (void)
{
int i;
@@ -316,11 +316,11 @@ void 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_REALCST(a,b,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; \
c_interop_kinds_table[a].value = c;
-#define NAMED_CMPXCST(a,b,c) \
+#define NAMED_CMPXCST(a,b,c,d) \
strncpy (c_interop_kinds_table[a].name, b, strlen(b) + 1); \
c_interop_kinds_table[a].f90_type = BT_COMPLEX; \
c_interop_kinds_table[a].value = c;
@@ -584,11 +584,9 @@ gfc_init_kinds (void)
/* Choose atomic kinds to match C's int. */
gfc_atomic_int_kind = gfc_c_int_kind;
gfc_atomic_logical_kind = gfc_c_int_kind;
-
- /* initialize the C interoperable kinds */
- init_c_interop_kinds();
}
+
/* Make sure that a valid kind is present. Returns an index into the
associated kinds array, -1 if the kind is not present. */
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index 57afd8c..2ab94b3 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -58,6 +58,7 @@ void gfc_convert_function_code (gfc_namespace *);
/* trans-types.c */
void gfc_init_kinds (void);
void gfc_init_types (void);
+void gfc_init_c_interop_kinds (void);
tree gfc_get_int_type (int);
tree gfc_get_real_type (int);
--- /dev/null 2011-09-28 07:54:13.747846082 +0200
+++ gcc/gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90 2011-09-28 14:38:42.000000000 +0200
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! Check that the GNU additions to ISO_C_Binding are properly diagnosed
+!
+use, intrinsic :: iso_c_binding, only: c_int128_t ! { dg-error "is not in the selected standard" }
+use, intrinsic :: iso_c_binding, only: c_int_least128_t ! { dg-error "is not in the selected standard" }
+use, intrinsic :: iso_c_binding, only: c_int_fast128_t ! { dg-error "is not in the selected standard" }
+use, intrinsic :: iso_c_binding, only: c_float128 ! { dg-error "is not in the selected standard" }
+use, intrinsic :: iso_c_binding, only: c_float128_complex ! { dg-error "is not in the selected standard" }
+implicit none
+end
--- /dev/null 2011-09-28 07:54:13.747846082 +0200
+++ gcc/gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90 2011-09-28 14:40:03.000000000 +0200
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-O -fdump-tree-optimized" }
+!
+! Check that the GNU additions to ISO_C_Binding are accepted
+!
+use, intrinsic :: iso_c_binding, only: c_int128_t
+use, intrinsic :: iso_c_binding, only: c_int_least128_t
+use, intrinsic :: iso_c_binding, only: c_int_fast128_t
+use, intrinsic :: iso_c_binding, only: c_float128
+use, intrinsic :: iso_c_binding, only: c_float128_complex
+implicit none
+if (c_int128_t >= 0 .and. c_int128_t /= 16) call unreachable()
+if (c_int_least128_t >= 0 .and. c_int_least128_t < 16) call unreachable()
+if (c_int_fast128_t >= 0 .and. c_int_fast128_t < 16) call unreachable()
+if (c_float128 >= 0 .and. c_float128 /= 16) call unreachable()
+if (c_float128_complex >= 0 .and. c_float128_complex /= 16) call unreachable()
+end
+
+! { dg-final { scan-tree-dump-times "unreachable" 0 "optimized" } }
+! { dg-final { cleanup-tree-dump "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_2.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_2.f90
index e163797..e3911fa 100644
--- a/gcc/testsuite/gfortran.dg/c_sizeof_2.f90
+++ b/gcc/testsuite/gfortran.dg/c_sizeof_2.f90
@@ -2,7 +2,7 @@
! { dg-options "-std=f2003 -Wall -Wno-conversion" }
! Support F2008's c_sizeof()
!
-USE ISO_C_BINDING, only: C_SIZE_T, c_sizeof ! { dg-error "new in Fortran 2008" }
+USE ISO_C_BINDING, only: C_SIZE_T, c_sizeof ! { dg-error "is not in the selected standard" }
integer(C_SIZE_T) :: i
i = c_sizeof(i)
end