Hi Harald,
It appears that something is not right and generates wrong code with
the check enabled. Can you have another look?
The problem was indeed that generating a formal from an actual
arglist is a bad idea when classes are involved. Fixed in the
attached patch. I think it still makes sense to remove the checks
when the other attributes are present (or PR96073 may come back
in different guise, even if I have to test case at present).
I have also converted the test to a run-time check.
Ok for trunk and backport to gcc-15?
Best regards
Thomas
gcc/fortran/ChangeLog:
PR fortran/119928
* interface.cc (gfc_check_dummy_characteristics): Do not issue
error if one dummy symbol has been generated from an actual
argument and the other one has OPTIONAL, INTENT, ALLOCATABLE,
POINTER, TARGET, VALUE, ASYNCHRONOUS or CONTIGUOUS.
(gfc_get_formal_from_actual_arglist): Do nothing if symbol
is a class.
gcc/testsuite/ChangeLog:
PR fortran/119928
* gfortran.dg/interface_60.f90: New test.diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 1e552a3df86..753f589ff67 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -1403,77 +1403,82 @@ gfc_check_dummy_characteristics (gfc_symbol *s1, gfc_symbol *s2,
}
}
- /* Check INTENT. */
- if (s1->attr.intent != s2->attr.intent && !s1->attr.artificial
- && !s2->attr.artificial)
-{
- snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* A lot of information is missing for artificially generated
+ formal arguments, let's not look into that. */
- /* Check OPTIONAL attribute. */
- if (s1->attr.optional != s2->attr.optional)
+ if (!s1->attr.artificial && !s2->attr.artificial)
{
- snprintf (errmsg, err_len, "OPTIONAL mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check INTENT. */
+ if (s1->attr.intent != s2->attr.intent)
+ {
+ snprintf (errmsg, err_len, "INTENT mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check ALLOCATABLE attribute. */
- if (s1->attr.allocatable != s2->attr.allocatable)
-{
- snprintf (errmsg, err_len, "ALLOCATABLE mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check OPTIONAL attribute. */
+ if (s1->attr.optional != s2->attr.optional)
+ {
+ snprintf (errmsg, err_len, "OPTIONAL mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check POINTER attribute. */
- if (s1->attr.pointer != s2->attr.pointer)
-{
- snprintf (errmsg, err_len, "POINTER mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check ALLOCATABLE attribute. */
+ if (s1->attr.allocatable != s2->attr.allocatable)
+ {
+ snprintf (errmsg, err_len, "ALLOCATABLE mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check TARGET attribute. */
- if (s1->attr.target != s2->attr.target)
-{
- snprintf (errmsg, err_len, "TARGET mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check POINTER attribute. */
+ if (s1->attr.pointer != s2->attr.pointer)
+ {
+ snprintf (errmsg, err_len, "POINTER mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check ASYNCHRONOUS attribute. */
- if (s1->attr.asynchronous != s2->attr.asynchronous)
-{
- snprintf (errmsg, err_len, "ASYNCHRONOUS mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check TARGET attribute. */
+ if (s1->attr.target != s2->attr.target)
+ {
+ snprintf (errmsg, err_len, "TARGET mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check CONTIGUOUS attribute. */
- if (s1->attr.contiguous != s2->attr.contiguous)
-{
- snprintf (errmsg, err_len, "CONTIGUOUS mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check ASYNCHRONOUS attribute. */
+ if (s1->attr.asynchronous != s2->attr.asynchronous)
+ {
+ snprintf (errmsg, err_len, "ASYNCHRONOUS mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check VALUE attribute. */
- if (s1->attr.value != s2->attr.value)
-{
- snprintf (errmsg, err_len, "VALUE mismatch in argument '%s'",
- s1->name);
- return false;
-}
+ /* Check CONTIGUOUS attribute. */
+ if (s1->attr.contiguous != s2->attr.contiguous)
+ {
+ snprintf (errmsg, err_len, "CONTIGUOUS mismatch in argument '%s'",
+ s1->name);
+ return false;
+ }
- /* Check VOLATILE attribute. */
- if (s1->attr.volatile_ != s2->attr.volatile_)
-{
- snprintf (errmsg, err_len, "VOLATILE mismatch in argument '%s'",
- s1->name);
- return false;
+ /* Check VALUE attribute. */
+ if (s1->attr.value != s2->attr.value)
+ {
+ snprintf (errmsg, err_len, "VALUE mismatch in argument '%s'",
