Make-lang.in (F95_PARSER_OBJS, [...]): Add dependency on iso-c-binding.def and iso...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8326a9ffd88ac9065acadb337fe2c6d491710ba8..d717831086723382c1fc2a90ae394abe7e261afa 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 08164587d0b5be3a148f8e48ab98de6dbd7a1d10..b766da651a2d4b2f0a31bd2298b2315a93cd4696 100644 (file)
--- 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 648831f260702511e4b04a53bd027d404a5eeb5f..8f8dd7d4c358b2bc953813555f9cb3f5c5ffdcdc 100644 (file)
--- 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 54e0b20580dc2758fbdc202c3ed943d35c0f9b93..1bd5ec36edd8832eaf38c7d035a7b950374c3d8c 100644 (file)
--- 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 9adeeabf60dcde853e14932e39fc7befb0842e3b..a093bec8c7c6fc1d86eedc18322b5b6e8a1b5472 100644 (file)
--- 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 bea83067bfe93c0dc369496598714baeba767af5..f8673b963c89cdf1ecc5a131777081662c6f336a 100644 (file)
--- 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 c8a377d2165755b9465e4f98e6259e1dd1f6c39d..62f759876d3a8bea1134e05b9118a50abce8750a 100644 (file)
--- 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 46eccb46abab59ebfda9800173d11f9952d2e2a2..4b506fe83e80695866ac5369f7e6effb3273cc2c 100644 (file)
--- 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 aa8e43bd8b80493bf65d9e36c7902e5a10825d63..4c5990e7ae162de65a9d20c80b1e1e673248b384 100644 (file)
--- 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 57afd8caef9db76df8c58cbdce83c4019190f807..2ab94b3f1848a6c4ad98a7139451f663e26b2b8c 100644 (file)
--- 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 67bd0400af216bff5dca662e26351c72157e6d84..c5717feed4c31047d5042d37f6e52b49204cb1fd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/c_sizeof_2.f90 b/gcc/testsuite/gfortran.dg/c_sizeof_2.f90
index e163797470fc3a95589cd9265c73940a28495953..e3911facf6a158df78e4072787215829ff78b991 100644 (file)
--- 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 (file)
index 0000000..dae9cc3
--- /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 (file)
index 0000000..7b78743
--- /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" } }