diff mbox series

PR fortran/102716 - ICE in gfc_validate_kind(): Got bad kind

Message ID trinity-7f14fd71-f975-409c-9526-668bbcd00d78-1634153815481@3c-app-gmx-bs17
State New
Headers show
Series PR fortran/102716 - ICE in gfc_validate_kind(): Got bad kind | expand

Commit Message

Harald Anlauf Oct. 13, 2021, 7:36 p.m. UTC 
Dear Fortranners,

another simple and obvious fix: we need to reorder the argument checks
to the SHAPE intrinsic so that invalid KIND arguments can be detected.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

As I consider this a safe fix, I'd like to backport to suitable branches.

Thanks,
Harald

Comments

Thomas Koenig Oct. 14, 2021, 6 a.m. UTC | #1 
Hi Harald,

> another simple and obvious fix: we need to reorder the argument checks
> to the SHAPE intrinsic so that invalid KIND arguments can be detected.
> 
> Regtested on x86_64-pc-linux-gnu.  OK for mainline?
> 
> As I consider this a safe fix, I'd like to backport to suitable branches.

Also OK for both.

Thanks a lot for the patch!

Best regards

	Thomas
diff mbox series

Patch

Fortran: fix order of checks for the SHAPE intrinsic

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.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 677209ee95e..cfaf9d26bbc 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -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
index 00000000000..4943c21b1d2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/shape_10.f90
@@ -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