aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>2024-03-19 15:09:22 +0100
committerFrancois-Xavier Coudert <fxcoudert@gcc.gnu.org>2024-04-29 16:24:20 +0200
commit050a4f7fc5c9c0f4aae26a92281cdca2a3ded53c (patch)
tree64f46b5a2be1ad3e0442760915502af7974b8963 /gcc
parent1dba1d860a1e3e32e5d061a1d6dc600c96d2597f (diff)
downloadgcc-050a4f7fc5c9c0f4aae26a92281cdca2a3ded53c.zip
gcc-050a4f7fc5c9c0f4aae26a92281cdca2a3ded53c.tar.gz
gcc-050a4f7fc5c9c0f4aae26a92281cdca2a3ded53c.tar.bz2
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.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/expr.cc11
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/gfortran.texi9
-rw-r--r--gcc/fortran/intrinsic.cc9
-rw-r--r--gcc/fortran/intrinsic.h1
-rw-r--r--gcc/fortran/intrinsic.texi43
-rw-r--r--gcc/fortran/simplify.cc22
-rw-r--r--gcc/fortran/trans-decl.cc7
-rw-r--r--gcc/fortran/trans-intrinsic.cc25
-rw-r--r--gcc/fortran/trans.h1
-rw-r--r--gcc/testsuite/gfortran.dg/selected_logical_kind_1.f9029
-rw-r--r--gcc/testsuite/gfortran.dg/selected_logical_kind_2.f909
-rw-r--r--gcc/testsuite/gfortran.dg/selected_logical_kind_3.f9018
-rw-r--r--gcc/testsuite/gfortran.dg/selected_logical_kind_4.f9023
14 files changed, 202 insertions, 6 deletions
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 09d1ebd..66edad5 100644
--- a/gcc/fortran/expr.cc
+++ b/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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5850544..a7a0fdb 100644
--- a/gcc/fortran/gfortran.h
+++ b/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,
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 371666d..7e8783a 100644
--- a/gcc/fortran/gfortran.texi
+++ b/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
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index c35f2bd..40f4c4f 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/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))
diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h
index 438160a..2c287ca 100644
--- a/gcc/fortran/intrinsic.h
+++ b/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 *);
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 0445fea..3d3b9ed 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/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
diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc
index 3043483..7a5d31c 100644
--- a/gcc/fortran/simplify.cc
+++ b/gcc/fortran/simplify.cc
@@ -7333,6 +7333,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)
{
int range, precision, radix, i, kind, found_precision, found_range,
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 301439b..dca7779 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/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,
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 4e26af2..8304118 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/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;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 2e10ce1..f94fa60 100644
--- a/gcc/fortran/trans.h
+++ b/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. */
diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_1.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_1.f90
new file mode 100644
index 0000000..18d8ded
--- /dev/null
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_2.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_2.f90
new file mode 100644
index 0000000..6f18958
--- /dev/null
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_3.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_3.f90
new file mode 100644
index 0000000..ac948e9
--- /dev/null
+++ b/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
diff --git a/gcc/testsuite/gfortran.dg/selected_logical_kind_4.f90 b/gcc/testsuite/gfortran.dg/selected_logical_kind_4.f90
new file mode 100644
index 0000000..0510991
--- /dev/null
+++ b/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