https://gcc.gnu.org/bugzilla/show_bug.cgi?id=93635
kargl at gcc dot gnu.org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|UNCONFIRMED |NEW
Last reconfirmed| |2020-02-09
CC| |kargl at gcc dot gnu.org
Ever confirmed|0 |1
--- Comment #1 from kargl at gcc dot gnu.org ---
The problem is in symbol.c (gfc_check_conflict). This check
if (attr->in_namelist && (attr->allocatable || attr->pointer))
{
a1 = in_namelist;
a2 = attr->allocatable ? allocatable : pointer;
standard = GFC_STD_F2003;
goto conflict_std;
}
jumps to conflict_std, where an error may or may not be issued.
In either case, gfc_check_conflict returns without any futher
checking of other attributes. There are four cases with the
conflict_std jump. This patch removes these jumps. It causes
a regression with pr87907.f90 where a correct error is emitted,
which is then followed by bunch of run-on errors. Removing the
of pr87907.f90 that leads to the run-on errors, then results in
a correct error message followed by an ICE. Likely, the bug
fix for pr87907.f90 needs to be re-evaluated. Fortuantely, I
use neither namelist nor equivalence, so have no skin in the
game. Someone else can complete the fix.
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 280157)
+++ gcc/fortran/symbol.c (working copy)
@@ -394,18 +395,35 @@ gfc_check_function_type (gfc_namespace *ns)
/******************** Symbol attribute stuff *********************/
+/* Older standard produced conflicts for some attributes that are now
+ allowed in newer standards. Check for the conflict and issue an
+ error depending on the standard in play. */
+
+static bool
+conflict_std (int standard, const char *a1, const char *a2, const char *name,
+ locus *where)
+{
+ if (name == NULL)
+ {
+ return gfc_notify_std (standard, "%s attribute conflicts "
+ "with %s attribute at %L", a1, a2,
+ where);
+ }
+ else
+ {
+ return gfc_notify_std (standard, "%s attribute conflicts "
+ "with %s attribute in %qs at %L",
+ a1, a2, name, where);
+ }
+}
+
+
+
/* This is a generic conflict-checker. We do this to avoid having a
single conflict in two places. */
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
-#define conf_std(a, b, std) if (attr->a && attr->b)\
- {\
- a1 = a;\
- a2 = b;\
- standard = std;\
- goto conflict_std;\
- }
bool
gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
@@ -438,7 +456,7 @@ gfc_check_conflict (symbol_attribute *attr, const char
"OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
- int standard;
+ bool standard;
if (attr->artificial)
return true;
@@ -450,16 +468,18 @@ gfc_check_conflict (symbol_attribute *attr, const char
{
a1 = pointer;
a2 = intent;
- standard = GFC_STD_F2003;
- goto conflict_std;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
}
if (attr->in_namelist && (attr->allocatable || attr->pointer))
{
a1 = in_namelist;
a2 = attr->allocatable ? allocatable : pointer;
- standard = GFC_STD_F2003;
- goto conflict_std;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
}
/* Check for attributes not allowed in a BLOCK DATA. */
@@ -566,9 +586,31 @@ gfc_check_conflict (symbol_attribute *attr, const char
return false;
conf (allocatable, pointer);
- conf_std (allocatable, dummy, GFC_STD_F2003);
- conf_std (allocatable, function, GFC_STD_F2003);
- conf_std (allocatable, result, GFC_STD_F2003);
+ if (attr->allocatable && attr->dummy)
+ {
+ a1 = allocatable;
+ a2 = dummy;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
+ if (attr->allocatable && attr->function)
+ {
+ a1 = allocatable;
+ a2 = function;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
+ if (attr->allocatable && attr->result)
+ {
+ a1 = allocatable;
+ a2 = result;
+ standard = conflict_std (GFC_STD_F2003, a1, a2, name, where);
+ if (!standard)
+ return standard;
+ }
+
conf (elemental, recursive);
conf (in_common, dummy);
@@ -908,25 +950,10 @@ conflict:
a1, a2, name, where);
return false;
-
-conflict_std:
- if (name == NULL)
- {
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute at %L", a1, a2,
- where);
- }
- else
- {
- return gfc_notify_std (standard, "%s attribute conflicts "
- "with %s attribute in %qs at %L",
- a1, a2, name, where);
- }
}
#undef conf
#undef conf2
-#undef conf_std
/* Mark a symbol as referenced. */
