]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: host association issue with symbol in COMMON block [PR108454]
authorHarald Anlauf <anlauf@gmx.de>
Thu, 30 Jan 2025 21:21:19 +0000 (22:21 +0100)
committerHarald Anlauf <anlauf@gmx.de>
Thu, 6 Feb 2025 19:41:55 +0000 (20:41 +0100)
When resolving a flavorless symbol that is already registered with a COMMON
block, and which neither has the intrinsic, generic, or external attribute,
skip searching among interfaces to avoid false resolution to a derived type
of the same name.

PR fortran/108454

gcc/fortran/ChangeLog:

* resolve.cc (resolve_common_blocks): Initialize variable.
(resolve_symbol): If a symbol is already registered with a COMMON
block, do not search for an interface with the same name.

gcc/testsuite/ChangeLog:

* gfortran.dg/common_29.f90: New test.

(cherry picked from commit d6418fe22684f9335474d1fd405ade45954c069d)

gcc/fortran/resolve.cc
gcc/testsuite/gfortran.dg/common_29.f90 [new file with mode: 0644]

index ca591e15e01e0d5b1c8c254482445dd5cc7f0495..4d5e8b5537ab8f4a3330c471d87c20ad211a7c92 100644 (file)
@@ -1040,7 +1040,7 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
 static void
 resolve_common_blocks (gfc_symtree *common_root)
 {
-  gfc_symbol *sym;
+  gfc_symbol *sym = NULL;
   gfc_gsymbol * gsym;
 
   if (common_root == NULL)
@@ -16354,6 +16354,12 @@ resolve_symbol (gfc_symbol *sym)
          && sym->attr.if_source == IFSRC_UNKNOWN
          && sym->ts.type == BT_UNKNOWN))
     {
+      /* A symbol in a common block might not have been resolved yet properly.
+        Do not try to find an interface with the same name.  */
+      if (sym->attr.flavor == FL_UNKNOWN && !sym->attr.intrinsic
+         && !sym->attr.generic && !sym->attr.external
+         && sym->attr.in_common)
+       goto skip_interfaces;
 
     /* If we find that a flavorless symbol is an interface in one of the
        parent namespaces, find its symtree in this namespace, free the
@@ -16377,6 +16383,7 @@ resolve_symbol (gfc_symbol *sym)
            }
        }
 
+skip_interfaces:
       /* Otherwise give it a flavor according to such attributes as
         it has.  */
       if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0
diff --git a/gcc/testsuite/gfortran.dg/common_29.f90 b/gcc/testsuite/gfortran.dg/common_29.f90
new file mode 100644 (file)
index 0000000..66f2a18
--- /dev/null
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! PR fortran/108454
+!
+! Contributed by G.Steinmetz
+
+module m
+  type t
+  end type
+contains
+  subroutine s
+    common t
+  end
+end
+
+module m2
+  implicit none
+  type t
+  end type
+contains
+  subroutine s
+    real :: t
+    common /com/ t
+  end
+end
+
+module m3
+  type t
+  end type
+contains
+  subroutine s
+    type(t) :: x  ! { dg-error "cannot be host associated at .1." }
+    common t      ! { dg-error "incompatible object of the same name" }
+  end
+end