Am Mo., 17. Sep. 2018 um 10:59 Uhr schrieb Bernhard Reutner-Fischer
<rep.dot....@gmail.com>:
>
> On Tue, 9 Nov 2010 at 11:41, Janus Weil <ja...@gcc.gnu.org> wrote:
> >
> > >> Ok, so it seems to me that using two leading underscores is really the
> > >> best option, since it's safe against collisions with Fortran and C
> > >> user code, and also safe to use with -fdollar-ok.
> > >>
> > >> The attached patch adds double underscores for the vtabs, vtypes,
> > >> class containers and temporaries.
> > >
> > > OK. Thanks for the patch!
> >
> > Committed as r166480.
> >
> > Thanks for all the helpful comments, everyone!
>
> Index: gcc/fortran/module.c
> ===================================================================
> --- gcc/fortran/module.c (revision 166419)
> +++ gcc/fortran/module.c (working copy)
> @@ -4372,8 +4372,8 @@ read_module (void)
> p = name;
>
> /* Exception: Always import vtabs & vtypes. */
> - if (p == NULL && (strncmp (name, "vtab$", 5) == 0
> - || strncmp (name, "vtype$", 6) == 0))
> + if (p == NULL && (strncmp (name, "__vtab_", 5) == 0
> + || strncmp (name, "__vtype_", 6) == 0))
> p = name;
>
> /* Skip symtree nodes not in an ONLY clause, unless there
>
> ---8<---
>
> Sorry for the late follow-up
'Late' is a pretty bold understatement for 8 years ;D
But in any case, 'late' is certainly better than 'never' ...
> but current trunk still has the code
> quoted above where we forgot to add 2 to the length parameter of both
> strncmp calls.
True! Thanks for noticing. I'll take care of fixing it.
> I think it would be nice to teach the C and C++ frontends to warn
> about this even though it might trigger in quite some code in the
> wild.
I don't really think this is a good idea. There are actually valid use
cases of strncmp, where the 'num' argument does not correspond to the
length of any of the two strings (in particular if they're not const).
Instead, for the sake of gfortran, how about a macro like this?
#define gfc_str_startswith(str, pref) \
(strncmp ((str), (pref), strlen (pref)) == 0)
(In fact I just noticed that something like this already exists in
trans-intrinsic.c, so I would just move it into gfortran.h and rename
it.)
> Looking at gcc/fortran alone there are
> gcc/fortran/interface.c: if (strncmp (mode, "unformatted", 9) == 0) // 11 !
I think this one could actually be a 'strcmp'?
> gcc/fortran/module.c: && (strncmp (name, "__vtab_", 5) == 0 // 7 !
> gcc/fortran/module.c: || strncmp (name, "__vtype_", 6) == 0)) //
> 8!
> gcc/fortran/module.c: || (strncmp (name, "__vtab_", 5) != 0 // 7!
> gcc/fortran/module.c: && strncmp (name, "__vtype_", 6)
> != 0)) // 8!
Here the new macro could be applied (and in a few other cases as
well), see attached patch.
I'm regtesting the patch now. Ok for trunk if it passes?
Cheers,
Janus
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 3d19ad479e5..91a1f34d7f1 100644
--- 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 04b0024a992..8f37a51d71c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3305,6 +3305,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 f85c76bad0f..ff6b2bb7ece 100644
--- 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 2eb8f7c9113..f2d6bbaec5c 100644
--- 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 993ea9f16b9..7b8e863ca0a 100644
--- 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 e8db54d4d37..73f5389361d 100644
--- 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 094f2101bbc..6f45afa86ea 100644
--- 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 e6180b889ec..a2beb7fc90a 100644
--- 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 06066eb93dd..159c3dbbc6b 100644
--- 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 35052a8a8ea..54a2877f8c5 100644
--- 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 b2cea93742a..d93f87b9e29 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8937,37 +8937,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;
}
