mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-06 11:40:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

gfortran.h (gfc_str_startswith): New macro.

Browse Source 
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
This commit is contained in:
Janus Weil 2018-09-20 21:33:05 +02:00
parent 5596651acd
commit 2eb3745a7b
12 changed files with 52 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View File

@ -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

4
gcc/fortran/decl.c
View File

@ -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;

3
gcc/fortran/gfortran.h
View File

@ -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 *);

4
gcc/fortran/interface.c
View File

@ -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;
}

2
gcc/fortran/iresolve.c
View File

@ -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

10
gcc/fortran/module.c
View File

@ -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. */

2
gcc/fortran/options.c
View File

@ -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];

6
gcc/fortran/primary.c
View File

@ -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;

6
gcc/fortran/resolve.c
View File

@ -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)

2
gcc/fortran/trans-decl.c
View File

@ -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;

8
gcc/fortran/trans-expr.c
View File

@ -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)

26
gcc/fortran/trans-intrinsic.c
View File

@ -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;
}