gfortran.h (gfc_str_startswith): New macro.

2018-09-20  Janus Weil  <janus@gcc.gnu.org>

	* gfortran.h (gfc_str_startswith): New macro.
	* decl.c (variable_decl, gfc_match_end): Use it.
	* iresolve.c (is_trig_resolved): Ditto.
	* module.c (load_omp_udrs, read_module): Ditto.
	* options.c (gfc_handle_runtime_check_option): Ditto.
	* primary.c (match_arg_list_function): Ditto.
	* trans-decl.c (gfc_get_symbol_decl): Ditto.
	* trans-expr.c (gfc_conv_procedure_call): Ditto.
	* interface.c (dtio_op): Replace strncmp by strcmp.
	* resolve.c (resolve_actual_arglist, resolve_function): Ditto.
	* trans-expr.c (conv_arglist_function): Ditto.
	* trans-intrinsic.c (gfc_conv_ieee_arithmetic_function): Replace macro
	STARTS_WITH by gfc_str_startswith.

From-SVN: r264448

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dd1e5b6eabcc5f7fa1d2af3a84ea3db23a7e5f29..7cbda093eee8488e9a7a4088ed5b7d0996264459 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2018-09-20  Janus Weil  <janus@gcc.gnu.org>
+
+       * gfortran.h (gfc_str_startswith): New macro.
+       * decl.c (variable_decl, gfc_match_end): Use it.
+       * iresolve.c (is_trig_resolved): Ditto.
+       * module.c (load_omp_udrs, read_module): Ditto.
+       * options.c (gfc_handle_runtime_check_option): Ditto.
+       * primary.c (match_arg_list_function): Ditto.
+       * trans-decl.c (gfc_get_symbol_decl): Ditto.
+       * trans-expr.c (gfc_conv_procedure_call): Ditto.
+       * interface.c (dtio_op): Replace strncmp by strcmp.
+       * resolve.c (resolve_actual_arglist, resolve_function): Ditto.
+       * trans-expr.c (conv_arglist_function): Ditto.
+       * trans-intrinsic.c (gfc_conv_ieee_arithmetic_function): Replace macro
+       STARTS_WITH by gfc_str_startswith.
+
 2018-09-20  Cesar Philippidis  <cesar@codesourcery.com>
 
        * dump-parse-tree.c (show_omp_clauses): Add missing omp list_types

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3d19ad479e5d70abc3bbe448561d3b3e8214d492..91a1f34d7f1dd6b1f343a70ca52d5d108780de41 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2529,7 +2529,7 @@ variable_decl (int elem)
     }
 
   /* %FILL components may not have initializers.  */
-  if (strncmp (name, "%FILL", 5) == 0 && gfc_match_eos () != MATCH_YES)
+  if (gfc_str_startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES)
     {
       gfc_error ("%qs entity cannot have an initializer at %C", "%FILL");
       m = MATCH_ERROR;
@@ -7811,7 +7811,7 @@ gfc_match_end (gfc_statement *st)
     {
     case COMP_ASSOCIATE:
     case COMP_BLOCK:
-      if (!strncmp (block_name, "block@", strlen("block@")))
+      if (gfc_str_startswith (block_name, "block@"))
        block_name = NULL;
       break;
 

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3359974d1084d4bfe7cc6e34837e20b41501e870..b0518e228e9a98aca64acd30d36876b006933302 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3310,6 +3310,9 @@ bool gfc_is_compile_time_shape (gfc_array_spec *);
 bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
 
 
+#define gfc_str_startswith(str, pref) \
+       (strncmp ((str), (pref), strlen (pref)) == 0)
+
 /* interface.c -- FIXME: some of these should be in symbol.c */
 void gfc_free_interface (gfc_interface *);
 bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f85c76bad0f9a9e2c460d4e96571e2f3ac36ca93..ff6b2bb7ece2099f72de47969dcd6b28fe4cbecb 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -122,9 +122,9 @@ fold_unary_intrinsic (gfc_intrinsic_op op)
 static gfc_intrinsic_op
 dtio_op (char* mode)
 {
-  if (strncmp (mode, "formatted", 9) == 0)
+  if (strcmp (mode, "formatted") == 0)
     return INTRINSIC_FORMATTED;
-  if (strncmp (mode, "unformatted", 9) == 0)
+  if (strcmp (mode, "unformatted") == 0)
     return INTRINSIC_UNFORMATTED;
   return INTRINSIC_NONE;
 }

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 2eb8f7c9113124fc2af89bd61147cbe898f0c569..f2d6bbaec5cea5faa52f8622825c007cbeaf1cd3 100644 (file)
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -698,7 +698,7 @@ is_trig_resolved (gfc_expr *f)
   /* We know we've already resolved the function if we see the lib call
      starting with '__'.  */
   return (f->value.function.name != NULL
-         && strncmp ("__", f->value.function.name, 2) == 0);
+         && gfc_str_startswith (f->value.function.name, "__"));
 }
 
 /* Return a shallow copy of the function expression f.  The original expression

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 993ea9f16b90331f893166fc5767a24ac37cf6c7..7b8e863ca0a0e1b98f62e7a4795d53c70ce91aee 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -4791,7 +4791,7 @@ load_omp_udrs (void)
       mio_pool_string (&name);
       gfc_clear_ts (&ts);
       mio_typespec (&ts);
-      if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0)
+      if (gfc_str_startswith (name, "operator "))
        {
          const char *p = name + sizeof ("operator ") - 1;
          if (strcmp (p, "+") == 0)
@@ -5233,8 +5233,8 @@ read_module (void)
 
          /* Exception: Always import vtabs & vtypes.  */
          if (p == NULL && name[0] == '_'
-             && (strncmp (name, "__vtab_", 5) == 0
-                 || strncmp (name, "__vtype_", 6) == 0))
+             && (gfc_str_startswith (name, "__vtab_")
+                 || gfc_str_startswith (name, "__vtype_")))
            p = name;
 
          /* Skip symtree nodes not in an ONLY clause, unless there
@@ -5319,8 +5319,8 @@ read_module (void)
                sym->attr.use_rename = 1;
 
              if (name[0] != '_'
-                 || (strncmp (name, "__vtab_", 5) != 0
-                     && strncmp (name, "__vtype_", 6) != 0))
+                 || (!gfc_str_startswith (name, "__vtab_")
+                     && !gfc_str_startswith (name, "__vtype_")))
                sym->attr.use_only = only_flag;
 
              /* Store the symtree pointing to this symbol.  */

diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index e8db54d4d3720663a090c9256a9e46bdee1143eb..73f5389361d9b1d1e9bc2888cb2516574cde4049 100644 (file)
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -565,7 +565,7 @@ gfc_handle_runtime_check_option (const char *arg)
              result = 1;
              break;
            }
-         else if (optname[n] && pos > 3 && strncmp ("no-", arg, 3) == 0
+         else if (optname[n] && pos > 3 && gfc_str_startswith (arg, "no-")
                   && strncmp (optname[n], arg+3, pos-3) == 0)
            {
              gfc_option.rtcheck &= ~optmask[n];

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 094f2101bbc553fb27f375eac8195e4e0a2a974c..6f45afa86ea36a65c3e56a8e76bac6a15d69601c 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1713,21 +1713,21 @@ match_arg_list_function (gfc_actual_arglist *result)
       switch (name[0])
        {
        case 'l':
-         if (strncmp (name, "loc", 3) == 0)
+         if (gfc_str_startswith (name, "loc"))
            {
              result->name = "%LOC";
              break;
            }
          /* FALLTHRU */
        case 'r':
-         if (strncmp (name, "ref", 3) == 0)
+         if (gfc_str_startswith (name, "ref"))
            {
              result->name = "%REF";
              break;
            }
          /* FALLTHRU */
        case 'v':
-         if (strncmp (name, "val", 3) == 0)
+         if (gfc_str_startswith (name, "val"))
            {
              result->name = "%VAL";
              break;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e6180b889ecbc47c80b8ea92c33b01b179f7b7b8..a2beb7fc90a8f8abb2be8262655f528f7fb0b555 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2061,7 +2061,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
         nothing to do for %REF.  */
       if (arg->name && arg->name[0] == '%')
        {
-         if (strncmp ("%VAL", arg->name, 4) == 0)
+         if (strcmp ("%VAL", arg->name) == 0)
            {
              if (e->ts.type == BT_CHARACTER || e->ts.type == BT_DERIVED)
                {
@@ -2093,7 +2093,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
            }
 
          /* Statement functions have already been excluded above.  */
-         else if (strncmp ("%LOC", arg->name, 4) == 0
+         else if (strcmp ("%LOC", arg->name) == 0
                   && e->ts.type == BT_PROCEDURE)
            {
              if (e->symtree->n.sym->attr.proc == PROC_INTERNAL)
@@ -3265,7 +3265,7 @@ resolve_function (gfc_expr *expr)
              if (arg->next->expr->expr_type != EXPR_CONSTANT)
                break;
 
-             if (arg->next->name && strncmp (arg->next->name, "kind", 4) == 0)
+             if (arg->next->name && strcmp (arg->next->name, "kind") == 0)
                break;
 
              if ((int)mpz_get_si (arg->next->expr->value.integer)

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 06066eb93dd40795d8a6c3ec6aeebb8e674fc8dd..159c3dbbc6b45634a9f1fa1138e4abd8862424b3 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1828,7 +1828,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
     GFC_DECL_ASSOCIATE_VAR_P (decl) = 1;
 
   if (sym->attr.vtab
-      || (sym->name[0] == '_' && strncmp ("__def_init", sym->name, 10) == 0))
+      || (sym->name[0] == '_' && gfc_str_startswith (sym->name, "__def_init")))
     TREE_READONLY (decl) = 1;
 
   return decl;

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 53b435947e91fc31739d35454b898d133b03e917..5a7cdb8f51972deba8579123cab2c6fdc0c51e45 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -4705,14 +4705,14 @@ conv_arglist_function (gfc_se *se, gfc_expr *expr, const char *name)
      indirectly for %LOC, else by reference.  Thus %REF
      is a "do-nothing" and %LOC is the same as an F95
      pointer.  */
-  if (strncmp (name, "%VAL", 4) == 0)
+  if (strcmp (name, "%VAL") == 0)
     gfc_conv_expr (se, expr);
-  else if (strncmp (name, "%LOC", 4) == 0)
+  else if (strcmp (name, "%LOC") == 0)
     {
       gfc_conv_expr_reference (se, expr);
       se->expr = gfc_build_addr_expr (NULL, se->expr);
     }
-  else if (strncmp (name, "%REF", 4) == 0)
+  else if (strcmp (name, "%REF") == 0)
     gfc_conv_expr_reference (se, expr);
   else
     gfc_error ("Unknown argument list function at %L", &expr->where);
@@ -5869,7 +5869,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       /* When calling __copy for character expressions to unlimited
         polymorphic entities, the dst argument needs a string length.  */
       if (sym->name[0] == '_' && e && e->ts.type == BT_CHARACTER
-         && strncmp (sym->name, "__vtab_CHARACTER", 16) == 0
+         && gfc_str_startswith (sym->name, "__vtab_CHARACTER")
          && arg->next && arg->next->expr
          && (arg->next->expr->ts.type == BT_DERIVED
              || arg->next->expr->ts.type == BT_CLASS)

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 0c83f4747977d7cc930ce13d1ca81024eabe051f..d068e011f25c52a6d4e05a871f8ad4e3e31fa089 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8938,37 +8938,33 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr)
 {
   const char *name = expr->value.function.name;
 
-#define STARTS_WITH(A,B) (strncmp((A), (B), strlen(B)) == 0)
-
-  if (STARTS_WITH (name, "_gfortran_ieee_is_nan"))
+  if (gfc_str_startswith (name, "_gfortran_ieee_is_nan"))
     conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISNAN, 1);
-  else if (STARTS_WITH (name, "_gfortran_ieee_is_finite"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_is_finite"))
     conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISFINITE, 1);
-  else if (STARTS_WITH (name, "_gfortran_ieee_unordered"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_unordered"))
     conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISUNORDERED, 2);
-  else if (STARTS_WITH (name, "_gfortran_ieee_is_normal"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_is_normal"))
     conv_intrinsic_ieee_is_normal (se, expr);
-  else if (STARTS_WITH (name, "_gfortran_ieee_is_negative"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_is_negative"))
     conv_intrinsic_ieee_is_negative (se, expr);
-  else if (STARTS_WITH (name, "_gfortran_ieee_copy_sign"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_copy_sign"))
     conv_intrinsic_ieee_copy_sign (se, expr);
-  else if (STARTS_WITH (name, "_gfortran_ieee_scalb"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_scalb"))
     conv_intrinsic_ieee_scalb (se, expr);
-  else if (STARTS_WITH (name, "_gfortran_ieee_next_after"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_next_after"))
     conv_intrinsic_ieee_next_after (se, expr);
-  else if (STARTS_WITH (name, "_gfortran_ieee_rem"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_rem"))
     conv_intrinsic_ieee_rem (se, expr);
-  else if (STARTS_WITH (name, "_gfortran_ieee_logb"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_logb"))
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_LOGB);
-  else if (STARTS_WITH (name, "_gfortran_ieee_rint"))
+  else if (gfc_str_startswith (name, "_gfortran_ieee_rint"))
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_RINT);
   else
     /* It is not among the functions we translate directly.  We return
        false, so a library function call is emitted.  */
     return false;
 
-#undef STARTS_WITH
-
   return true;
 }