Make-lang.in (F95_PARSER_OBJS, [...]): Add dependency on iso-c-binding.def and iso-fortran-env.def.
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 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. From-SVN: r179725
This commit is contained in:
parent
3a0a357821
commit
28d0b59566
@ -1,3 +1,21 @@
|
||||
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
|
||||
|
@ -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 \
|
||||
|
@ -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 ();
|
||||
}
|
||||
|
||||
|
||||
|
@ -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,
|
||||
|
@ -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
|
||||
|
@ -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))
|
||||
|
@ -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; \
|
||||
create_intrinsic_function (b, (gfc_isym_id) c, \
|
||||
iso_c_module_name, \
|
||||
INTMOD_ISO_C_BINDING); \
|
||||
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: \
|
||||
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)
|
||||
|
@ -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"
|
||||
|
@ -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. */
|
||||
|
||||
|
@ -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);
|
||||
|
@ -1,3 +1,9 @@
|
||||
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
|
||||
|
@ -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
|
||||
|
12
gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90
Normal file
12
gcc/testsuite/gfortran.dg/iso_c_binding_param_1.f90
Normal file
@ -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
|
20
gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90
Normal file
20
gcc/testsuite/gfortran.dg/iso_c_binding_param_2.f90
Normal file
@ -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" } }
|
Loading…
Reference in New Issue
Block a user