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,
