From 44814d9436b2e0be14b76b137602e40f3fdaf805 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 18 Nov 2023 22:51:35 +0100
Subject: [PATCH] Fortran: restrictions on integer arguments to SYSTEM_CLOCK
 [PR112609]

Fortran 2023 added restrictions on integer arguments to SYSTEM_CLOCK to
have a decimal exponent range at least as large as a default integer,
and that all integer arguments have the same kind type parameter.

gcc/fortran/ChangeLog:

	PR fortran/112609
	* check.cc (gfc_check_system_clock): Add checks on integer arguments
	to SYSTEM_CLOCK specific to F2023.
	* error.cc (notify_std_msg): Adjust to handle new features added
	in F2023.

gcc/testsuite/ChangeLog:

	PR fortran/112609
	* gfortran.dg/system_clock_4.f90: New test.
---
 gcc/fortran/check.cc                         | 57 ++++++++++++++++++++
 gcc/fortran/error.cc                         |  4 +-
 gcc/testsuite/gfortran.dg/system_clock_4.f90 | 24 +++++++++
 3 files changed, 84 insertions(+), 1 deletion(-)
 create mode 100644 gcc/testsuite/gfortran.dg/system_clock_4.f90

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 6c45e6542f0..8c2534ae1c9 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -6774,6 +6774,10 @@ bool
 gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate,
 			gfc_expr *count_max)
 {
+  int first_int_kind = -1;
+  bool f2023 = ((gfc_option.allow_std & GFC_STD_F2023) != 0
+		&& (gfc_option.allow_std & GFC_STD_GNU) == 0);
+
   if (count != NULL)
     {
       if (!scalar_check (count, 0))
@@ -6788,8 +6792,18 @@ gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate,
 			      &count->where))
 	return false;

+      if (f2023 && count->ts.kind < gfc_default_integer_kind)
+	{
+	  gfc_error ("Fortran 2023: COUNT argument to SYSTEM_CLOCK "
+		     "at %L must have kind of at least default integer",
+		     &count->where);
+	  return false;
+	}
+
       if (!variable_check (count, 0, false))
 	return false;
+
+      first_int_kind = count->ts.kind;
     }

   if (count_rate != NULL)
@@ -6816,6 +6830,17 @@ gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate,
 				  "SYSTEM_CLOCK at %L has non-default kind",
 				  &count_rate->where))
 	    return false;
+
+	  if (f2023 && count_rate->ts.kind < gfc_default_integer_kind)
+	    {
+	      gfc_error ("Fortran 2023: COUNT_RATE argument to SYSTEM_CLOCK "
+			 "at %L must have kind of at least default integer",
+			 &count_rate->where);
+	      return false;
+	    }
+
+	  if (first_int_kind < 0)
+	    first_int_kind = count_rate->ts.kind;
 	}

     }
@@ -6836,6 +6861,38 @@ gfc_check_system_clock (gfc_expr *count, gfc_expr *count_rate,

       if (!variable_check (count_max, 2, false))
 	return false;
+
+      if (f2023 && count_max->ts.kind < gfc_default_integer_kind)
+	{
+	  gfc_error ("Fortran 2023: COUNT_MAX argument to SYSTEM_CLOCK "
+		     "at %L must have kind of at least default integer",
+		     &count_max->where);
+	  return false;
+	}
+
+      if (first_int_kind < 0)
+	first_int_kind = count_max->ts.kind;
+    }
+
+  if (f2023 && first_int_kind > 0)
+    {
+      if (count_rate
+	  && count_rate->ts.type == BT_INTEGER
+	  && count_rate->ts.kind != first_int_kind)
+	{
+	  gfc_error ("Fortran 2023: all integer arguments to SYSTEM_CLOCK "
+		     "at %L must have the same kind",
+		     &count_rate->where);
+	  return false;
+	}
+
+      if (count_max && count_max->ts.kind != first_int_kind)
+	{
+	  gfc_error ("Fortran 2023: all integer arguments to SYSTEM_CLOCK "
+		     "at %L must have the same kind",
+		     &count_max->where);
+	  return false;
+	}
     }

   return true;
diff --git a/gcc/fortran/error.cc b/gcc/fortran/error.cc
index 2ac51e95e4d..b8b36c0cd7c 100644
--- a/gcc/fortran/error.cc
+++ b/gcc/fortran/error.cc
@@ -980,7 +980,9 @@ char const*
 notify_std_msg(int std)
 {

-  if (std & GFC_STD_F2018_DEL)
+  if (std & GFC_STD_F2023)
+    return _("Fortran 2023:");
+  else if (std & GFC_STD_F2018_DEL)
     return _("Fortran 2018 deleted feature:");
   else if (std & GFC_STD_F2018_OBS)
     return _("Fortran 2018 obsolescent feature:");
diff --git a/gcc/testsuite/gfortran.dg/system_clock_4.f90 b/gcc/testsuite/gfortran.dg/system_clock_4.f90
new file mode 100644
index 00000000000..f2d706f6d8c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/system_clock_4.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-options "-std=f2023" }
+! PR fortran/112609 - F2023 restrictions on integer arguments to SYSTEM_CLOCK
+
+program p
+  implicit none
+  integer    :: i,  j,  k
+  integer(2) :: i2, j2, k2
+  integer(8) :: i8, j8, k8
+  real       :: x
+
+  call system_clock(count=i2)      ! { dg-error "at least default integer" }
+  call system_clock(count_rate=j2) ! { dg-error "at least default integer" }
+  call system_clock(count_max=k2)  ! { dg-error "at least default integer" }
+
+  call system_clock(count=i8,count_rate=x,count_max=k8)
+  call system_clock(count=i, count_rate=j8)     ! { dg-error "must have the same kind" }
+  call system_clock(count=i8,count_rate=j)      ! { dg-error "must have the same kind" }
+  call system_clock(count=i, count_max=k8)      ! { dg-error "must have the same kind" }
+  call system_clock(count=i8,count_max=k)       ! { dg-error "must have the same kind" }
+  call system_clock(count_rate=j, count_max=k8) ! { dg-error "must have the same kind" }
+  call system_clock(count_rate=j8,count_max=k)  ! { dg-error "must have the same kind" }
+  call system_clock(i,x,k8)                     ! { dg-error "must have the same kind" }
+end
--
2.35.3