]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Fix comp call in associate [PR119272]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Mon, 17 Mar 2025 07:24:04 +0000 (08:24 +0100)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Wed, 19 Mar 2025 13:55:59 +0000 (14:55 +0100)
PR fortran/119272

gcc/fortran/ChangeLog:

* resolve.cc (resolve_compcall): Postpone error report when
symbol is not resolved yet for component call resolve.

gcc/testsuite/ChangeLog:

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

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

index ddd9827023091cfc0e6c0a442220623e3d4131b6..b9c469a5beca8014ba2a832d77c83109b626a233 100644 (file)
@@ -7351,8 +7351,9 @@ resolve_compcall (gfc_expr* e, const char **name)
   /* Check that's really a FUNCTION.  */
   if (!e->value.compcall.tbp->function)
     {
-      gfc_error ("%qs at %L should be a FUNCTION",
-                e->value.compcall.name, &e->where);
+      if (e->symtree && e->symtree->n.sym->resolve_symbol_called)
+       gfc_error ("%qs at %L should be a FUNCTION", e->value.compcall.name,
+                  &e->where);
       return false;
     }
 
diff --git a/gcc/testsuite/gfortran.dg/associate_74.f90 b/gcc/testsuite/gfortran.dg/associate_74.f90
new file mode 100644 (file)
index 0000000..057d635
--- /dev/null
@@ -0,0 +1,47 @@
+!{ dg-do run }
+
+! Check that PR119272 is fixed
+! Contributed by Xing Jing Wei  <xingjingwei666@gmail.com>
+
+module pr119272_module
+   type, public :: test_type
+      contains
+      procedure :: scal_function
+      procedure :: arr_function
+   end type test_type
+   contains
+   function scal_function(this) result(smth)
+      class(test_type) :: this
+      integer :: smth
+      smth = 2
+   end function
+   function arr_function(this) result(smth)
+      class(test_type) :: this
+      integer :: smth(9)
+      smth = (/(i, i=1, 9)/)
+   end function
+end module
+
+program pr119272
+      use pr119272_module
+      implicit none
+      
+      type(test_type) :: a
+              
+      call test_subroutine(a)
+      contains
+      subroutine test_subroutine(a)
+            class(test_type) :: a
+            integer :: i
+            integer,parameter :: temp_int(3) = [ 1, 2, 3]
+            integer,parameter :: identity(9) = (/(i* 5, i= 9, 1, -1)/)
+            associate(temp => temp_int(a%scal_function()))
+                if (temp /= 2) stop 1
+            end associate
+
+            associate(temparr => identity(a%arr_function()))
+                if (any(temparr /= (/(i* 5, i= 9, 1, -1)/))) stop 2
+            end associate
+      end subroutine
+end program
+