https://gcc.gnu.org/bugzilla/show_bug.cgi?id=77507

--- Comment #2 from Steve Kargl <sgk at troutmask dot apl.washington.edu> ---
On Wed, Sep 07, 2016 at 10:12:22PM +0000, kargl at gcc dot gnu.org wrote:
>
> This should have been 2 separate bug reports as ieee support
> is distinct from ISO C binding support.  This patch fixes
> the latter, but cannot be committed because you've tied it
> to the former.
> 

This appears to fix both issues.

Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c     (revision 240029)
+++ gcc/fortran/intrinsic.c     (working copy)
@@ -1239,7 +1239,8 @@ add_functions (void)
     *z = "z", *ln = "len", *ut = "unit", *han = "handler",
     *num = "number", *tm = "time", *nm = "name", *md = "mode",
     *vl = "values", *p1 = "path1", *p2 = "path2", *com = "command",
-    *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed";
+    *ca = "coarray", *sub = "sub", *dist = "distance", *failed="failed",
+    *c_ptr_1 = "c_ptr_1", *c_ptr_2 = "c_ptr_2";

   int di, dr, dd, dl, dc, dz, ii;

@@ -2914,8 +2915,8 @@ add_functions (void)
   /* The following functions are part of ISO_C_BINDING.  */
   add_sym_2 ("c_associated", GFC_ISYM_C_ASSOCIATED, CLASS_INQUIRY, ACTUAL_NO,
             BT_LOGICAL, dl, GFC_STD_F2003, gfc_check_c_associated, NULL, NULL,
-            "C_PTR_1", BT_VOID, 0, REQUIRED,
-            "C_PTR_2", BT_VOID, 0, OPTIONAL);
+            c_ptr_1, BT_VOID, 0, REQUIRED,
+            c_ptr_2, BT_VOID, 0, OPTIONAL);
   make_from_module();

   add_sym_1 ("c_loc", GFC_ISYM_C_LOC, CLASS_INQUIRY, ACTUAL_NO,
Index: libgfortran/ieee/ieee_arithmetic.F90
===================================================================
--- libgfortran/ieee/ieee_arithmetic.F90        (revision 240029)
+++ libgfortran/ieee/ieee_arithmetic.F90        (working copy)
@@ -857,12 +857,12 @@ contains

   ! IEEE_VALUE

-  elemental real(kind=4) function IEEE_VALUE_4(X, C) result(res)
-    implicit none
+  elemental real(kind=4) function IEEE_VALUE_4(X, CLASS) result(res)
+
     real(kind=4), intent(in) :: X
-    type(IEEE_CLASS_TYPE), intent(in) :: C
+    type(IEEE_CLASS_TYPE), intent(in) :: CLASS

-    select case (C%hidden)
+    select case (CLASS%hidden)
       case (1)     ! IEEE_SIGNALING_NAN
         res = -1
         res = sqrt(res)
@@ -895,12 +895,12 @@ contains
      end select
   end function

-  elemental real(kind=8) function IEEE_VALUE_8(X, C) result(res)
-    implicit none
+  elemental real(kind=8) function IEEE_VALUE_8(X, CLASS) result(res)
+
     real(kind=8), intent(in) :: X
-    type(IEEE_CLASS_TYPE), intent(in) :: C
+    type(IEEE_CLASS_TYPE), intent(in) :: CLASS

-    select case (C%hidden)
+    select case (CLASS%hidden)
       case (1)     ! IEEE_SIGNALING_NAN
         res = -1
         res = sqrt(res)
@@ -934,12 +934,12 @@ contains
   end function

 #ifdef HAVE_GFC_REAL_10
-  elemental real(kind=10) function IEEE_VALUE_10(X, C) result(res)
-    implicit none
+  elemental real(kind=10) function IEEE_VALUE_10(X, CLASS) result(res)
+
     real(kind=10), intent(in) :: X
-    type(IEEE_CLASS_TYPE), intent(in) :: C
+    type(IEEE_CLASS_TYPE), intent(in) :: CLASS

-    select case (C%hidden)
+    select case (CLASS%hidden)
       case (1)     ! IEEE_SIGNALING_NAN
         res = -1
         res = sqrt(res)
@@ -971,15 +971,16 @@ contains
         res = 0
      end select
   end function
+
 #endif

 #ifdef HAVE_GFC_REAL_16
-  elemental real(kind=16) function IEEE_VALUE_16(X, C) result(res)
-    implicit none
+  elemental real(kind=16) function IEEE_VALUE_16(X, CLASS) result(res)
+
     real(kind=16), intent(in) :: X
-    type(IEEE_CLASS_TYPE), intent(in) :: C
+    type(IEEE_CLASS_TYPE), intent(in) :: CLASS

-    select case (C%hidden)
+    select case (CLASS%hidden)
       case (1)     ! IEEE_SIGNALING_NAN
         res = -1
         res = sqrt(res)

Reply via email to