]> git.ipfire.org Git - thirdparty/gcc.git/blobdiff - gcc/fortran/intrinsic.cc
Update copyright years.
[thirdparty/gcc.git] / gcc / fortran / intrinsic.cc
index 52e5f4ed39eb4dcf7973a5e9b9210788115253a4..c35f2bdd1835d85fd36d39d33f87cca8aaad93c5 100644 (file)
@@ -1,6 +1,6 @@
 /* Build up a list of intrinsic subroutines and functions for the
    name-resolution stage.
-   Copyright (C) 2000-2022 Free Software Foundation, Inc.
+   Copyright (C) 2000-2024 Free Software Foundation, Inc.
    Contributed by Andy Vaught & Katherine Holcomb
 
 This file is part of GCC.
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "options.h"
 #include "gfortran.h"
 #include "intrinsic.h"
+#include "diagnostic.h" /* For errorcount.  */
 
 /* Namespace to hold the resolved symbols for intrinsic subroutines.  */
 static gfc_namespace *gfc_intrinsic_namespace;
@@ -1106,7 +1107,7 @@ gfc_find_subroutine (const char *name)
 /* Given a string, figure out if it is the name of a generic intrinsic
    function or not.  */
 
-int
+bool
 gfc_generic_intrinsic (const char *name)
 {
   gfc_intrinsic_sym *sym;
@@ -1119,7 +1120,7 @@ gfc_generic_intrinsic (const char *name)
 /* Given a string, figure out if it is the name of a specific
    intrinsic function or not.  */
 
-int
+bool
 gfc_specific_intrinsic (const char *name)
 {
   gfc_intrinsic_sym *sym;
@@ -1131,7 +1132,7 @@ gfc_specific_intrinsic (const char *name)
 
 /* Given a string, figure out if it is the name of an intrinsic function
    or subroutine allowed as an actual argument or not.  */
-int
+bool
 gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
 {
   gfc_intrinsic_sym *sym;
@@ -1164,6 +1165,7 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
 
   /* Check for attributes which prevent the symbol from being INTRINSIC.  */
   if (sym->attr.external || sym->attr.contained
+      || sym->attr.recursive
       || sym->attr.if_source == IFSRC_IFBODY)
     return false;
 
@@ -1184,7 +1186,7 @@ gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
        gfc_warning_now (OPT_Wintrinsics_std, "The intrinsic %qs at %L is not "
                         "included in the selected standard but %s and %qs will"
                         " be treated as if declared EXTERNAL.  Use an"
-                        " appropriate %<-std=%>* option or define"
+                        " appropriate %<-std=%> option or define"
                         " %<-fall-intrinsics%> to allow this intrinsic.",
                         sym->name, &loc, symstd, sym->name);
 
@@ -3308,72 +3310,75 @@ add_functions (void)
   make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
 
 
-  /* The next of intrinsic subprogram are the degree trignometric functions.
-     These were hidden behind the -fdec-math option, but are now simply
-     included as extensions to the set of intrinsic subprograms.  */
+  /* The degree trigonometric functions were added as part of the DEC
+     Fortran compatibility effort, and were hidden behind a -fdec-math
+     option.  Fortran 2023 has added some of these functions to Fortran
+     standard as generic subprogram, e.g., acosd() is added while dacosd()
+     is not.  So, update GFC_STD_GNU to GFC_STD_F2023 for the generic
+     functions.  */
 
   add_sym_1 ("acosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_fn_r, gfc_simplify_acosd, gfc_resolve_trigd,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_F2023);
+
   add_sym_1 ("dacosd", GFC_ISYM_ACOSD, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_fn_d, gfc_simplify_acosd, gfc_resolve_trigd,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("acosd", GFC_ISYM_ACOSD, GFC_STD_GNU);
-
   add_sym_1 ("asind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_fn_r, gfc_simplify_asind, gfc_resolve_trigd,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_F2023);
+
   add_sym_1 ("dasind", GFC_ISYM_ASIND, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_fn_d, gfc_simplify_asind, gfc_resolve_trigd,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("asind", GFC_ISYM_ASIND, GFC_STD_GNU);
-
   add_sym_1 ("atand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_fn_r, gfc_simplify_atand, gfc_resolve_trigd,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("atand", GFC_ISYM_ATAND, GFC_STD_F2023);
+
   add_sym_1 ("datand", GFC_ISYM_ATAND, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_fn_d, gfc_simplify_atand, gfc_resolve_trigd,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("atand", GFC_ISYM_ATAND, GFC_STD_GNU);
-
   add_sym_2 ("atan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_atan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
             y, BT_REAL, dr, REQUIRED,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("atan2d", GFC_ISYM_ATAN2D, GFC_STD_F2023);
+
   add_sym_2 ("datan2d", GFC_ISYM_ATAN2D, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_datan2, gfc_simplify_atan2d, gfc_resolve_trigd2,
             y, BT_REAL, dd, REQUIRED,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("atan2d", GFC_ISYM_ATAN2D, GFC_STD_GNU);
-
   add_sym_1 ("cosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_fn_r, gfc_simplify_cosd, gfc_resolve_trigd,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_F2023);
+
   add_sym_1 ("dcosd", GFC_ISYM_COSD, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_fn_d, gfc_simplify_cosd, gfc_resolve_trigd,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("cosd", GFC_ISYM_COSD, GFC_STD_GNU);
-
   add_sym_1 ("cotan", GFC_ISYM_COTAN, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dr, GFC_STD_GNU,
             gfc_check_fn_rc2008, gfc_simplify_cotan, gfc_resolve_trigd,
@@ -3409,29 +3414,29 @@ add_functions (void)
   make_generic ("cotand", GFC_ISYM_COTAND, GFC_STD_GNU);
 
   add_sym_1 ("sind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_fn_r, gfc_simplify_sind, gfc_resolve_trigd,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("sind", GFC_ISYM_SIND, GFC_STD_F2023);
+
   add_sym_1 ("dsind", GFC_ISYM_SIND, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_fn_d, gfc_simplify_sind, gfc_resolve_trigd,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("sind", GFC_ISYM_SIND, GFC_STD_GNU);
-
   add_sym_1 ("tand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
-            BT_REAL, dr, GFC_STD_GNU,
+            BT_REAL, dr, GFC_STD_F2023,
             gfc_check_fn_r, gfc_simplify_tand, gfc_resolve_trigd,
             x, BT_REAL, dr, REQUIRED);
 
+  make_generic ("tand", GFC_ISYM_TAND, GFC_STD_F2023);
+
   add_sym_1 ("dtand", GFC_ISYM_TAND, CLASS_ELEMENTAL, ACTUAL_YES,
             BT_REAL, dd, GFC_STD_GNU,
             gfc_check_fn_d, gfc_simplify_tand, gfc_resolve_trigd,
             x, BT_REAL, dd, REQUIRED);
 
-  make_generic ("tand", GFC_ISYM_TAND, GFC_STD_GNU);
-
   /* The following function is internally used for coarray libray functions.
      "make_from_module" makes it inaccessible for external users.  */
   add_sym_1 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
@@ -4258,15 +4263,15 @@ remove_nullargs (gfc_actual_arglist **ap)
 }
 
 
-static gfc_dummy_arg *
-get_intrinsic_dummy_arg (gfc_intrinsic_arg *intrinsic)
+static void
+set_intrinsic_dummy_arg (gfc_dummy_arg *&dummy_arg,
+                        gfc_intrinsic_arg *intrinsic)
 {
-  gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg ();
+  if (dummy_arg == NULL)
+    dummy_arg = gfc_get_dummy_arg ();
 
   dummy_arg->intrinsicness = GFC_INTRINSIC_DUMMY_ARG;
   dummy_arg->u.intrinsic = intrinsic;
-
-  return dummy_arg;
 }
 
 
@@ -4429,7 +4434,7 @@ do_sort:
       if (a == NULL)
        a = gfc_get_actual_arglist ();
 
-      a->associated_dummy = get_intrinsic_dummy_arg (f);
+      set_intrinsic_dummy_arg (a->associated_dummy, f);
 
       if (actual == NULL)
        *ap = a;
@@ -4619,6 +4624,7 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
 {
   gfc_expr *result, *a1, *a2, *a3, *a4, *a5, *a6;
   gfc_actual_arglist *arg;
+  int old_errorcount = errorcount;
 
   /* Max and min require special handling due to the variable number
      of args.  */
@@ -4707,7 +4713,12 @@ do_simplify (gfc_intrinsic_sym *specific, gfc_expr *e)
 
 finish:
   if (result == &gfc_bad_expr)
-    return false;
+    {
+      if (errorcount == old_errorcount
+         && (!gfc_buffered_p () || !gfc_error_flag_test ()))
+       gfc_error ("Cannot simplify expression at %L", &e->where);
+      return false;
+    }
 
   if (result == NULL)
     resolve_intrinsic (specific, e);   /* Must call at run-time */
@@ -4881,6 +4892,10 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
       symstd_msg = _("new in Fortran 2018");
       break;
 
+    case GFC_STD_F2023:
+      symstd_msg = _("new in Fortran 2023");
+      break;
+
     case GFC_STD_GNU:
       symstd_msg = _("a GNU Fortran extension");
       break;
@@ -5418,7 +5433,8 @@ gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
   gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
 
   sym = find_char_conv (&expr->ts, ts);
-  gcc_assert (sym);
+  if (sym == NULL)
+    return false;
 
   /* Insert a pre-resolved function call to the right function.  */
   old_where = expr->where;