Fortran: fix order of checks for the SHAPE intrinsic
authorHarald Anlauf <anlauf@gmx.de>
Thu, 14 Oct 2021 18:18:14 +0000 (20:18 +0200)
committerHarald Anlauf <anlauf@gmx.de>
Thu, 14 Oct 2021 18:18:14 +0000 (20:18 +0200)
gcc/fortran/ChangeLog:

PR fortran/102716
* check.c (gfc_check_shape): Reorder checks so that invalid KIND
arguments can be detected.

gcc/testsuite/ChangeLog:

PR fortran/102716
* gfortran.dg/shape_10.f90: New test.

gcc/fortran/check.c
gcc/testsuite/gfortran.dg/shape_10.f90 [new file with mode: 0644]

index 677209e..cfaf9d2 100644 (file)
@@ -5086,6 +5086,13 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind)
   if (gfc_invalid_null_arg (source))
     return false;
 
+  if (!kind_check (kind, 1, BT_INTEGER))
+    return false;
+  if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
+                              "with KIND argument at %L",
+                              gfc_current_intrinsic, &kind->where))
+    return false;
+
   if (source->rank == 0 || source->expr_type != EXPR_VARIABLE)
     return true;
 
@@ -5098,13 +5105,6 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind)
       return false;
     }
 
-  if (!kind_check (kind, 1, BT_INTEGER))
-    return false;
-  if (kind && !gfc_notify_std (GFC_STD_F2003, "%qs intrinsic "
-                              "with KIND argument at %L",
-                              gfc_current_intrinsic, &kind->where))
-    return false;
-
   return true;
 }
 
diff --git a/gcc/testsuite/gfortran.dg/shape_10.f90 b/gcc/testsuite/gfortran.dg/shape_10.f90
new file mode 100644 (file)
index 0000000..4943c21
--- /dev/null
@@ -0,0 +1,6 @@
+! { dg-do compile }
+! PR fortran/102716
+
+program p
+  integer, parameter :: a(1) = shape([2], [1]) ! { dg-error "must be a scalar" }
+end