Fortran: add SELECTED_LOGICAL_KIND

gcc/fortran/ChangeLog:
	* expr.cc (check_transformational): Add SELECTED_LOGICAL_KIND
	to allowed functions for Fortran 2023.
	* gfortran.h (GFC_ISYM_SL_KIND): New.
	* gfortran.texi: Mention SELECTED_LOGICAL_KIND.
	* intrinsic.cc (add_functions): Add SELECTED_LOGICAL_KIND.
	(gfc_intrinsic_func_interface): Allow it in initialization
	expressions.
	* intrinsic.h (gfc_simplify_selected_logical_kind): New proto.
	* intrinsic.texi: Add SELECTED_LOGICAL_KIND.
	* simplify.cc (gfc_simplify_selected_logical_kind): New
	function.
	* trans-decl.cc (gfc_build_intrinsic_function_decls): Initialize
	gfor_fndecl_sl_kind.
	* trans-intrinsic.cc (gfc_conv_intrinsic_sl_kind): New function.
	(gfc_conv_intrinsic_function): Call it for GFC_ISYM_SL_KIND.
	* trans.h (gfor_fndecl_sl_kind): New symbol.

gcc/testsuite/ChangeLog:

	* gfortran.dg/selected_logical_kind_1.f90: New test.
	* gfortran.dg/selected_logical_kind_2.f90: New test.
	* gfortran.dg/selected_logical_kind_3.f90: New test.
	* gfortran.dg/selected_logical_kind_4.f90: New test.

libgfortran/ChangeLog:

	* gfortran.map: Add _gfortran_selected_logical_kind.
	* intrinsics/selected_int_kind.f90: Add SELECTED_LOGICAL_KIND.

gcc/fortran/expr.cc

@@ -2885,6 +2885,13 @@ check_transformational (gfc_expr *e)
     "trim", "unpack", "findloc", NULL
   };
 
+  static const char * const trans_func_f2023[] =  {
+    "all", "any", "count", "dot_product", "matmul", "null", "pack",
+    "product", "repeat", "reshape", "selected_char_kind", "selected_int_kind",
+    "selected_logical_kind", "selected_real_kind", "spread", "sum", "transfer",
+    "transpose", "trim", "unpack", "findloc", NULL
+  };
+
   int i;
   const char *name;
   const char *const *functions;
@@ -2895,7 +2902,9 @@ check_transformational (gfc_expr *e)
 
   name = e->symtree->n.sym->name;
 
-  if (gfc_option.allow_std & GFC_STD_F2008)
+  if (gfc_option.allow_std & GFC_STD_F2023)
+    functions = trans_func_f2023;
+  else if (gfc_option.allow_std & GFC_STD_F2008)
     functions = trans_func_f2008;
   else if (gfc_option.allow_std & GFC_STD_F2003)
     functions = trans_func_f2003;

gcc/fortran/gfortran.h

@@ -662,6 +662,7 @@ enum gfc_isym_id
   GFC_ISYM_SIND,
   GFC_ISYM_SINH,
   GFC_ISYM_SIZE,
+  GFC_ISYM_SL_KIND,
   GFC_ISYM_SLEEP,
   GFC_ISYM_SIZEOF,
   GFC_ISYM_SNGL,

gcc/fortran/gfortran.texi

@@ -862,8 +862,8 @@ data types are:
 The @code{KIND} value matches the storage size in bytes, except for
 @code{COMPLEX} where the storage size is twice as much (or both real and
 imaginary part are a real value of the given size).  It is recommended to use
-the @ref{SELECTED_CHAR_KIND}, @ref{SELECTED_INT_KIND} and
-@ref{SELECTED_REAL_KIND} intrinsics or the @code{INT8}, @code{INT16},
+the @ref{SELECTED_CHAR_KIND}, @ref{SELECTED_INT_KIND}, @ref{SELECTED_LOGICAL_KIND}
+and @ref{SELECTED_REAL_KIND} intrinsics or the @code{INT8}, @code{INT16},
 @code{INT32}, @code{INT64}, @code{REAL32}, @code{REAL64}, and @code{REAL128}
 parameters of the @code{ISO_FORTRAN_ENV} module instead of the concrete values.
 The available kind parameters can be found in the constant arrays
@@ -1272,8 +1272,9 @@ equivalent to the standard-conforming declaration
 @noindent
 where @code{k} is the kind parameter suitable for the intended precision.  As
 kind parameters are implementation-dependent, use the @code{KIND},
-@code{SELECTED_INT_KIND} and @code{SELECTED_REAL_KIND} intrinsics to retrieve
-the correct value, for instance @code{REAL*8 x} can be replaced by:
+@code{SELECTED_INT_KIND}, @code{SELECTED_LOGICAL_KIND} and
+@code{SELECTED_REAL_KIND} intrinsics to retrieve the correct value, for
+instance @code{REAL*8 x} can be replaced by:
 @smallexample
 INTEGER, PARAMETER :: dbl = KIND(1.0d0)
 REAL(KIND=dbl) :: x

gcc/fortran/intrinsic.cc

@@ -2952,6 +2952,12 @@ add_functions (void)
 
   make_generic ("selected_int_kind", GFC_ISYM_SI_KIND, GFC_STD_F95);
 
+  add_sym_1 ("selected_logical_kind", GFC_ISYM_SL_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
+	     GFC_STD_F2023, /* it has the same requirements */ gfc_check_selected_int_kind,
+	     gfc_simplify_selected_logical_kind, NULL, r, BT_INTEGER, di, REQUIRED);
+
+  make_generic ("selected_logical_kind", GFC_ISYM_SL_KIND, GFC_STD_F2023);
+
   add_sym_3 ("selected_real_kind", GFC_ISYM_SR_KIND, CLASS_TRANSFORMATIONAL, ACTUAL_NO, BT_INTEGER, di,
 	     GFC_STD_F95, gfc_check_selected_real_kind,
 	     gfc_simplify_selected_real_kind, NULL,
@@ -5003,7 +5009,8 @@ gfc_intrinsic_func_interface (gfc_expr *expr, int error_flag)
       gfc_isym_id id = isym->id;
       if (id != GFC_ISYM_REPEAT && id != GFC_ISYM_RESHAPE
 	  && id != GFC_ISYM_SI_KIND && id != GFC_ISYM_SR_KIND
-	  && id != GFC_ISYM_TRANSFER && id != GFC_ISYM_TRIM
+	  && id != GFC_ISYM_SL_KIND && id != GFC_ISYM_TRANSFER
+	  && id != GFC_ISYM_TRIM
 	  && !gfc_notify_std (GFC_STD_F2003, "Transformational function %qs "
 			      "at %L is invalid in an initialization "
 			      "expression", sym->name, &expr->where))

gcc/fortran/intrinsic.h

@@ -399,6 +399,7 @@ gfc_expr *gfc_simplify_scale (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_scan (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_selected_char_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_int_kind (gfc_expr *);
+gfc_expr *gfc_simplify_selected_logical_kind (gfc_expr *);
 gfc_expr *gfc_simplify_selected_real_kind (gfc_expr *, gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_set_exponent (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_sign (gfc_expr *, gfc_expr *);

gcc/fortran/intrinsic.texi

@@ -281,6 +281,7 @@ Some basic guidelines for editing this document:
 * @code{SECOND}:        SECOND,    CPU time function
 * @code{SELECTED_CHAR_KIND}: SELECTED_CHAR_KIND,  Choose character kind
 * @code{SELECTED_INT_KIND}: SELECTED_INT_KIND,  Choose integer kind
+* @code{SELECTED_LOGICAL_KIND}: SELECTED_LOGICAL_KIND,  Choose logical kind
 * @code{SELECTED_REAL_KIND}: SELECTED_REAL_KIND,  Choose real kind
 * @code{SET_EXPONENT}:  SET_EXPONENT, Set the exponent of the model
 * @code{SHAPE}:         SHAPE,     Determine the shape of an array
@@ -12788,6 +12789,48 @@ end program large_integers
 
 
 
+@node SELECTED_LOGICAL_KIND
+@section @code{SELECTED_LOGICAL_KIND} --- Choose logical kind
+@fnindex SELECTED_LOGICAL_KIND
+@cindex logical kind
+@cindex kind, logical
+
+@table @asis
+@item @emph{Description}:
+@code{SELECTED_LOGICAL_KIND(BITS)} return the kind value of the smallest
+logical type whose storage size in bits is at least @var{BITS}. If there
+is no such logical kind, @code{SELECTED_LOGICAL_KIND} returns @math{-1}.
+
+@item @emph{Standard}:
+Fortran 2023 and later
+
+@item @emph{Class}:
+Transformational function
+
+@item @emph{Syntax}:
+@code{RESULT = SELECTED_LOGICAL_KIND(BITS)}
+
+@item @emph{Arguments}:
+@multitable @columnfractions .15 .70
+@item @var{BITS} @tab Shall be a scalar and of type @code{INTEGER}.
+@end multitable
+
+@item @emph{Example}:
+@smallexample
+program logical_kinds
+  integer, parameter :: k1 = selected_logical_kind(1)
+  integer, parameter :: k40 = selected_logical_kind(40)
+  logical(kind=k1) :: l1    ! At least one bit
+  logical(kind=k40) :: l40  ! At least 40 bits
+
+  ! What is their actual size?
+  print *, storage_size(l1), storage_size(l40)
+end program logical_kinds
+@end smallexample
+@end table
+
+
+
 @node SELECTED_REAL_KIND
 @section @code{SELECTED_REAL_KIND} --- Choose real kind
 @fnindex SELECTED_REAL_KIND

gcc/fortran/simplify.cc

@@ -7332,6 +7332,28 @@ gfc_simplify_selected_int_kind (gfc_expr *e)
 }
 
 
+gfc_expr *
+gfc_simplify_selected_logical_kind (gfc_expr *e)
+{
+  int i, kind, bits;
+
+  if (e->expr_type != EXPR_CONSTANT || gfc_extract_int (e, &bits))
+    return NULL;
+
+  kind = INT_MAX;
+
+  for (i = 0; gfc_logical_kinds[i].kind != 0; i++)
+    if (gfc_logical_kinds[i].bit_size >= bits
+	&& gfc_logical_kinds[i].kind < kind)
+      kind = gfc_logical_kinds[i].kind;
+
+  if (kind == INT_MAX)
+    kind = -1;
+
+  return gfc_get_int_expr (gfc_default_integer_kind, &e->where, kind);
+}
+
+
 gfc_expr *
 gfc_simplify_selected_real_kind (gfc_expr *p, gfc_expr *q, gfc_expr *rdx)
 {

gcc/fortran/trans-decl.cc

@@ -221,6 +221,7 @@ tree gfor_fndecl_is_contiguous0;
 /* Intrinsic functions implemented in Fortran.  */
 tree gfor_fndecl_sc_kind;
 tree gfor_fndecl_si_kind;
+tree gfor_fndecl_sl_kind;
 tree gfor_fndecl_sr_kind;
 
 /* BLAS gemm functions.  */
@@ -3605,6 +3606,12 @@ gfc_build_intrinsic_function_decls (void)
   DECL_PURE_P (gfor_fndecl_si_kind) = 1;
   TREE_NOTHROW (gfor_fndecl_si_kind) = 1;
 
+  gfor_fndecl_sl_kind = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("selected_logical_kind")), ". R ",
+	gfc_int4_type_node, 1, pvoid_type_node);
+  DECL_PURE_P (gfor_fndecl_sl_kind) = 1;
+  TREE_NOTHROW (gfor_fndecl_sl_kind) = 1;
+
   gfor_fndecl_sr_kind = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("selected_real_kind2008")), ". R R ",
 	gfc_int4_type_node, 3, pvoid_type_node, pvoid_type_node,

gcc/fortran/trans-intrinsic.cc

@@ -9187,6 +9187,27 @@ gfc_conv_intrinsic_si_kind (gfc_se *se, gfc_expr *expr)
 }
 
 
+/* Generate code for SELECTED_LOGICAL_KIND (BITS) intrinsic function.  */
+
+static void
+gfc_conv_intrinsic_sl_kind (gfc_se *se, gfc_expr *expr)
+{
+  tree arg, type;
+
+  gfc_conv_intrinsic_function_args (se, expr, &arg, 1);
+
+  /* The argument to SELECTED_LOGICAL_KIND is INTEGER(4).  */
+  type = gfc_get_int_type (4);
+  arg = gfc_build_addr_expr (NULL_TREE, fold_convert (type, arg));
+
+  /* Convert it to the required type.  */
+  type = gfc_typenode_for_spec (&expr->ts);
+  se->expr = build_call_expr_loc (input_location,
+			      gfor_fndecl_sl_kind, 1, arg);
+  se->expr = fold_convert (type, se->expr);
+}
+
+
 /* Generate code for SELECTED_REAL_KIND (P, R, RADIX) intrinsic function.  */
 
 static void
@@ -10618,6 +10639,10 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       gfc_conv_intrinsic_si_kind (se, expr);
       break;
 
+    case GFC_ISYM_SL_KIND:
+      gfc_conv_intrinsic_sl_kind (se, expr);
+      break;
+
     case GFC_ISYM_SR_KIND:
       gfc_conv_intrinsic_sr_kind (se, expr);
       break;

gcc/fortran/trans.h

@@ -978,6 +978,7 @@ extern GTY(()) tree gfor_fndecl_is_contiguous0;
 /* Implemented in Fortran.  */
 extern GTY(()) tree gfor_fndecl_sc_kind;
 extern GTY(()) tree gfor_fndecl_si_kind;
+extern GTY(()) tree gfor_fndecl_sl_kind;
 extern GTY(()) tree gfor_fndecl_sr_kind;
 
 /* IEEE-related.  */

gcc/testsuite/gfortran.dg/selected_logical_kind_1.f90

@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program selected
+  implicit none
+
+  integer, parameter :: k = max(1, selected_logical_kind(128))
+  logical(kind=k) :: l
+
+  ! This makes assumptions about the targets, but they are true
+  ! for all targets that gfortran supports
+
+  if (selected_logical_kind(1)  /= 1) STOP 1
+  if (selected_logical_kind(8)  /= 1) STOP 2
+  if (selected_logical_kind(9)  /= 2) STOP 3
+  if (selected_logical_kind(16) /= 2) STOP 4
+  if (selected_logical_kind(17) /= 4) STOP 5
+  if (selected_logical_kind(32) /= 4) STOP 6
+  if (selected_logical_kind(33) /= 8) STOP 7
+  if (selected_logical_kind(64) /= 8) STOP 8
+
+  ! This should not exist
+
+  if (selected_logical_kind(17921) /= -1) STOP 9
+
+  ! We test for a kind larger than 64 bits separately
+
+  if (storage_size(l) /= 8 * k) STOP 10
+
+end program

gcc/testsuite/gfortran.dg/selected_logical_kind_2.f90

@@ -0,0 +1,9 @@
+! { dg-do compile }
+! { dg-options "-std=f2018" }
+
+program selected
+  implicit none
+
+  logical(selected_logical_kind(1)) :: l ! { dg-error "has no IMPLICIT type" }
+  print *, selected_logical_kind(1) ! { dg-error "has no IMPLICIT type" }
+end program

gcc/testsuite/gfortran.dg/selected_logical_kind_3.f90

@@ -0,0 +1,18 @@
+! { dg-do run }
+! { dg-require-effective-target fortran_integer_16 }
+
+program selected
+  implicit none
+
+  integer, parameter :: k1 = selected_logical_kind(128)
+  logical(kind=k1) :: l
+
+  integer, parameter :: k2 = selected_int_kind(25)
+  integer(kind=k2) :: i
+
+  if (storage_size(l) /= 8 * k1) STOP 1
+  if (storage_size(i) /= 8 * k2) STOP 2
+  if (bit_size(i) /= 8 * k2) STOP 3
+  if (k1 /= k2) STOP 4
+
+end program

gcc/testsuite/gfortran.dg/selected_logical_kind_4.f90

@@ -0,0 +1,23 @@
+! { dg-do run }
+
+! Check that SELECTED_LOGICAL_KIND works in a non-constant context
+! (which is rare but allowed)
+
+subroutine foo(i, j)
+  implicit none
+  integer :: i, j
+  if (selected_logical_kind(i) /= j) STOP j
+end subroutine
+
+program selected
+  implicit none
+
+  call foo(1, 1)
+  call foo(8, 1)
+  call foo(9, 2)
+  call foo(16, 2)
+  call foo(17, 4)
+  call foo(32, 4)
+  call foo(33, 8)
+  call foo(64, 8)
+end program

libgfortran/gfortran.map

@@ -1765,3 +1765,8 @@ GFORTRAN_13 {
     __ieee_exceptions_MOD_ieee_get_modes;
     __ieee_exceptions_MOD_ieee_set_modes;
 } GFORTRAN_12;
+
+GFORTRAN_14 {
+  global:
+    _gfortran_selected_logical_kind;
+} GFORTRAN_13;

libgfortran/intrinsics/selected_int_kind.f90

@@ -24,7 +24,7 @@
 
 function _gfortran_selected_int_kind (r)
   implicit none
-  integer, intent (in) :: r
+  integer, intent(in) :: r
   integer :: _gfortran_selected_int_kind
   integer :: i
   ! Integer kind_range table
@@ -36,11 +36,37 @@ function _gfortran_selected_int_kind (r)
   include "selected_int_kind.inc"
 
   do i = 1, c
-    if (r <= int_infos (i) % range) then
-      _gfortran_selected_int_kind = int_infos (i) % kind
+    if (r <= int_infos(i)%range) then
+      _gfortran_selected_int_kind = int_infos(i)%kind
       return
     end if
   end do
   _gfortran_selected_int_kind = -1
   return
 end function
+
+
+! At this time, our logical and integer kinds are the same
+
+function _gfortran_selected_logical_kind (bits)
+  implicit none
+  integer, intent(in) :: bits
+  integer :: _gfortran_selected_logical_kind
+  integer :: i
+  ! Integer kind_range table
+  type :: int_info
+    integer :: kind
+    integer :: range
+  end type int_info
+
+  include "selected_int_kind.inc"
+
+  do i = 1, c
+    if (bits <= 8 * int_infos(i)%kind) then
+      _gfortran_selected_logical_kind = int_infos(i)%kind
+      return
+    end if
+  end do
+  _gfortran_selected_logical_kind = -1
+  return
+end function