]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
backport: re PR fortran/77506 (F2008 Standard does not allow CHARACTER(LEN=*) in...
authorSteven G. Kargl <kargl@gcc.gnu.org>
Thu, 29 Sep 2016 20:32:22 +0000 (20:32 +0000)
committerSteven G. Kargl <kargl@gcc.gnu.org>
Thu, 29 Sep 2016 20:32:22 +0000 (20:32 +0000)
2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>

Backport from trunk
PR fortran/77506
* array.c (gfc_match_array_constructor): CHARACTER(len=*) cannot
appear in an array constructor.

PR fortran/77507
* intrinsic.c (add_functions):  Use correct keyword.

2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>

Backport from trunk
PR fortran/77507
  * ieee/ieee_arithmetic.F90 (IEEE_VALUE_4,IEEE_VALUE_8,IEEE_VALULE_10,
IEEE_VALUE_16):  Use correct keyword.

2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>

Backport from trunk
PR fortran/77506
* gfortran.dg/pr77506.f90: New test.

PR fortran/77507
* gfortran.dg/pr77507.f90: New test.

From-SVN: r240636

gcc/fortran/ChangeLog
gcc/fortran/array.c
gcc/fortran/intrinsic.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/c_assoc_2.f03
gcc/testsuite/gfortran.dg/c_assoc_4.f90
gcc/testsuite/gfortran.dg/ieee/pr77507.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/pr77506.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/ieee/ieee_arithmetic.F90

index 29be78c3eb2e6380b3f7683beb6de6a8ed453a0c..4fa70563718b8610402bc2ca56cbf5c7580e7c01 100644 (file)
@@ -1,3 +1,13 @@
+2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/77506
+       * array.c (gfc_match_array_constructor): CHARACTER(len=*) cannot
+       appear in an array constructor.
+
+       PR fortran/77507
+       * intrinsic.c (add_functions):  Use correct keyword.
+
 2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        Backport from trunk
index ea48549dd56dd87fe30b609f2ec612d5d8535fc5..980bde0137fa65bd68fb096cb060dae2624ff2b9 100644 (file)
@@ -1110,6 +1110,15 @@ gfc_match_array_constructor (gfc_expr **result)
              gfc_restore_last_undo_checkpoint ();
              goto cleanup;
            }
+
+         if (ts.type == BT_CHARACTER
+             && ts.u.cl && !ts.u.cl->length && !ts.u.cl->length_from_typespec)
+           {
+             gfc_error ("Type-spec at %L cannot contain an asterisk for a "
+                        "type parameter", &where);
+             gfc_restore_last_undo_checkpoint ();
+             goto cleanup;
+           }
        }
     }
   else if (m == MATCH_ERROR)
index 3a971cb79d6bf43f9a25c63d5bde302d7bc7faca..55c733fd1c51f590670b4781c9336ccdc92a3516 100644 (file)
@@ -1205,7 +1205,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;
 
@@ -2775,8 +2776,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 f16c2ca4d0cc4e7143f0cf109a35ba10cd8952d5..d8599ae2c942479b4ed4e89e3a21a6eb263b2740 100644 (file)
@@ -1,3 +1,12 @@
+2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/77506
+       * gfortran.dg/pr77506.f90: New test.
+
+       PR fortran/77507
+       * gfortran.dg/pr77507.f90: New test.
+
 2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        Backport from trunk
index 275e88eadc38d7d3e19b6fac5686c0e775d8c74f..5d7724900db3cc061f94733cab60a013f1c9c257 100644 (file)
@@ -20,7 +20,7 @@ contains
        call abort()
     end if
 
-    if(.not. c_associated()) then ! { dg-error "Missing actual argument 'C_PTR_1' in call to 'c_associated'" }
+    if(.not. c_associated()) then ! { dg-error "Missing actual argument 'c_ptr_1' in call to 'c_associated'" }
        call abort()
     end if
 
index 5421a363f10aad5328cd858909d831572949aa8c..8a7fe736bc5f90df08c15e25e81dbdec5babc61e 100644 (file)
@@ -9,6 +9,6 @@ PROGRAM test
 
   TYPE (C_PTR) :: x, y
 
-  PRINT *, C_ASSOCIATED([x,y])  ! { dg-error "'C_PTR_1' argument of 'c_associated' intrinsic at .1. must be a scalar" }
+  PRINT *, C_ASSOCIATED([x,y])  ! { dg-error "'c_ptr_1' argument of 'c_associated' intrinsic at .1. must be a scalar" }
 
 END PROGRAM test
diff --git a/gcc/testsuite/gfortran.dg/ieee/pr77507.f90 b/gcc/testsuite/gfortran.dg/ieee/pr77507.f90
new file mode 100644 (file)
index 0000000..a72a091
--- /dev/null
@@ -0,0 +1,7 @@
+! { dg-do compile }
+Program p
+  Use ieee_arithmetic
+  Use iso_c_binding
+  Print *, ieee_value(x=1.0, class=ieee_negative_inf)
+  Print *, c_associated(c_ptr_1=c_null_ptr)
+End Program
diff --git a/gcc/testsuite/gfortran.dg/pr77506.f90 b/gcc/testsuite/gfortran.dg/pr77506.f90
new file mode 100644 (file)
index 0000000..70d874e
--- /dev/null
@@ -0,0 +1,4 @@
+! { dg-do compile }
+program foo
+   print *, [character(len=*)::'ab','cd'] ! { dg-error "contain an asterisk" }
+end program foo
index 93bf9f2e82fdd2c9b82dc25164c0852835cab4ef..5d310d42d14c7b05167985a414a3478d68edb026 100644 (file)
@@ -1,3 +1,10 @@
+2016-09-29  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       Backport from trunk
+       PR fortran/77507
+       * ieee/ieee_arithmetic.F90 (IEEE_VALUE_4,IEEE_VALUE_8,IEEE_VALULE_10,
+       IEEE_VALUE_16):  Use correct keyword.
+
 2016-08-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        Backport from trunk
index f81a4f89e1329c3d7d784caa9bd3c6f9453837f1..ee89058597619a6851a9fb9a11c629dc82cbfee1 100644 (file)
@@ -500,12 +500,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)
@@ -538,12 +538,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)