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

            Bug ID: 97408
           Summary: Diagnose non-constant KIND argument to intrinsics
           Product: gcc
           Version: unknown
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
          Assignee: unassigned at gcc dot gnu.org
          Reporter: anlauf at gcc dot gnu.org
  Target Milestone: ---

While looking at PR91963, I found that non-constant KIND arguments are not
properly diagnosed.

The test:

! { dg-do compile }
!
program p
  implicit none
  integer :: i
  integer, parameter :: lk(1) = [ 4 ]
  print *, (int     (1     , lk(i)), i=1,1) ! { dg-error "must be a constant" }
  print *, (real    (1     , lk(i)), i=1,1) ! { dg-error "must be a constant" }
  print *, (cmplx   (1, kind=lk(i)), i=1,1) ! { dg-error "must be a constant" }
  print *, (logical (.true., lk(i)), i=1,1) ! { dg-error "must be a constant" }
end

produces:

kind_2.f90:7:29:

    7 |   print *, (int     (1     , lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: Invalid kind for INTEGER at (1)
kind_2.f90:8:29:

    8 |   print *, (real    (1     , lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: Invalid kind for REAL at (1)
kind_2.f90:9:29:

    9 |   print *, (cmplx   (1, kind=lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: Invalid kind for COMPLEX at (1)
kind_2.f90:10:29:

   10 |   print *, (logical (.true., lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: Invalid kind for LOGICAL at (1)


but should diagnose:

kind_2.f90:7:29:

    7 |   print *, (int     (1     , lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: 'kind' argument of 'int' intrinsic at (1) must be a constant
kind_2.f90:8:29:

    8 |   print *, (real    (1     , lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: 'kind' argument of 'real' intrinsic at (1) must be a constant
kind_2.f90:9:29:

    9 |   print *, (cmplx   (1, kind=lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: 'kind' argument of 'cmplx' intrinsic at (1) must be a constant
kind_2.f90:10:29:

   10 |   print *, (logical (.true., lk(i)), i=1,1) ! { dg-error "must be a
constant" }
      |                             1
Error: 'kind' argument of 'logical' intrinsic at (1) must be a constant


Obvious patch:

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 1e64fab3401..f2b502af3ca 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -646,7 +646,7 @@ kind_check (gfc_expr *k, int n, bt type)
   if (!scalar_check (k, n))
     return false;

-  if (!gfc_check_init_expr (k))
+  if (!gfc_check_init_expr (k) || k->expr_type == EXPR_VARIABLE)
     {
       gfc_error ("%qs argument of %qs intrinsic at %L must be a constant",
                 gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,

Reply via email to