]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Fix associate with derived type array construtor [PR117347]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Fri, 13 Dec 2024 08:06:11 +0000 (09:06 +0100)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Tue, 17 Dec 2024 07:12:23 +0000 (08:12 +0100)
gcc/fortran/ChangeLog:

PR fortran/117347

* primary.cc (gfc_match_varspec): Add array constructors for
guessing their type like with unresolved function calls.

gcc/testsuite/ChangeLog:

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

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

index 1db27929eebd60fb92973e323174f12b368d9625..ab49eac450f6db47a79b0c7384e9be24e8b57cd5 100644 (file)
@@ -2423,6 +2423,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
         component name 're' or 'im' could be found.  */
       if (tgt_expr
          && (tgt_expr->expr_type == EXPR_FUNCTION
+             || tgt_expr->expr_type == EXPR_ARRAY
              || (!resolved && tgt_expr->expr_type == EXPR_OP))
          && (sym->ts.type == BT_UNKNOWN
              || (inferred_type && sym->ts.type != BT_COMPLEX))
diff --git a/gcc/testsuite/gfortran.dg/associate_71.f90 b/gcc/testsuite/gfortran.dg/associate_71.f90
new file mode 100644 (file)
index 0000000..8f67b53
--- /dev/null
@@ -0,0 +1,39 @@
+! { dg-do run }
+!
+! Check that pr117347 is fixed.
+! Contributed by Ivan Pribec  <ivan.pribec@gmail.com>
+
+program pr117347
+  implicit none
+
+  type :: point
+     real :: x = 42.
+  end type point
+
+  type(point) :: mypoint
+  real        :: pi(1)
+  associate (points =>  mypoint )
+    pi(:) = points% x
+  end associate
+  if (any(pi /= 42)) stop 1
+  associate (points => (mypoint))
+    pi(:) = points% x
+  end associate
+  if (any(pi /= 42)) stop 2
+  associate (points => [mypoint])
+    pi(:) = points% x
+  end associate
+  if (any(pi /= 42)) stop 3
+  associate (points => [rpoint()])
+    pi(:) = points% x
+  end associate
+  if (any(pi /= 35)) stop 4
+
+contains
+
+  function rpoint() result(r)
+    type(point) :: r
+    r%x = 35
+  end function
+end program
+