+2011-10-09 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-10-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/50659
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 \
/* Set up F95 type nodes. */
gfc_init_kinds ();
gfc_init_types ();
+ gfc_init_c_interop_kinds ();
}
#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,
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
@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
#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
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))
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) \
}
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)
{
#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"
/* 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;
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;
/* 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. */
/* 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);
+2011-10-09 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.
+
2011-10-09 Ira Rosen <ira.rosen@linaro.org>
PR tree-optimization/50635
! { 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
--- /dev/null
+! { 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
+! { 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" } }
OSDN Git Service
