From 28d0b595667285b8d95e5dd024f76b365f60ade8 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sun, 9 Oct 2011 17:36:18 +0200 Subject: [PATCH] Make-lang.in (F95_PARSER_OBJS, [...]): Add dependency on iso-c-binding.def and iso-fortran-env.def. 2011-10-09 Tobias Burnus * 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 Tobias Burnus * 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. From-SVN: r179725 --- gcc/fortran/ChangeLog | 18 +++ gcc/fortran/Make-lang.in | 6 +- gcc/fortran/f95-lang.c | 1 + gcc/fortran/gfortran.h | 4 +- gcc/fortran/intrinsic.texi | 6 +- gcc/fortran/iso-c-binding.def | 24 ++-- gcc/fortran/module.c | 105 ++++++++++++++++-- gcc/fortran/symbol.c | 4 +- gcc/fortran/trans-types.c | 12 +- gcc/fortran/trans-types.h | 1 + gcc/testsuite/ChangeLog | 6 + gcc/testsuite/gfortran.dg/c_sizeof_2.f90 | 2 +- .../gfortran.dg/iso_c_binding_param_1.f90 | 12 ++ .../gfortran.dg/iso_c_binding_param_2.f90 | 20 ++++ 14 files changed, 186 insertions(+), 35 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8326a9ffd88..d7178310867 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2011-10-09 Tobias Burnus + + * 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 PR fortran/50659 diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index 08164587d0b..b766da651a2 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 648831f2607..8f8dd7d4c35 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 54e0b20580d..1bd5ec36edd 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 9adeeabf60d..a093bec8c7c 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 bea83067bfe..f8673b963c8 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 c8a377d2165..62f759876d3 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -5350,8 +5350,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) \ @@ -5374,23 +5419,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 46eccb46aba..4b506fe83e8 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -4336,8 +4336,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 aa8e43bd8b8..4c5990e7ae1 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 57afd8caef9..2ab94b3f184 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 67bd0400af2..c5717feed4c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-10-09 Tobias Burnus + + * 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 PR tree-optimization/50635 diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_2.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_2.f90 index e163797470f..e3911facf6a 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 diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90 new file mode 100644 index 00000000000..dae9cc3703f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90 b/gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90 new file mode 100644 index 00000000000..7b78743452a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90 @@ -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" } } -- 2.30.2