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:
Tobias Burnus 2011-10-09 17:36:18 +02:00 committed by Tobias Burnus
parent 3a0a357821
commit 28d0b59566
14 changed files with 186 additions and 35 deletions

View File

@ -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

View File

@ -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 \

View File

@ -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 ();
}

View File

@ -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,

View File

@ -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

View File

@ -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))

View File

@ -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)

View File

@ -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"

View File

@ -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. */

View File

@ -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);

View File

@ -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

View File

@ -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

View 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

View 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" } }