[gcc r12-4414] Fortran: fix order of checks for the SHAPE intrinsic

[Harald Anlauf <anlauf@gcc.gnu.org>]

https://gcc.gnu.org/g:1b115daf62d94337b3d0b2962b0bbbf005a450e0

commit r12-4414-g1b115daf62d94337b3d0b2962b0bbbf005a450e0
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Thu Oct 14 20:18:14 2021 +0200

    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:
---
 gcc/fortran/check.c                    | 14 +++++++-------
 gcc/testsuite/gfortran.dg/shape_10.f90 |  6 ++++++
 2 files changed, 13 insertions(+), 7 deletions(-)

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