Fortran: Failure with 1st PDT example in F2018 standard [PR122766]

2025-11-24  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/122766
	* decl.cc (gfc_match_decl_type_spec): A pdt_type found while
	parsing a contains section can only arise from the typespec of
	a function declaration. This can be retained in the typespec.
	Once we are parsing the function, the first reference to this
	derived type will find that it has no symtree. Provide it with
	one so that gfc_use_derived does not complain and, again,retain
	it in the typespec.

gcc/testsuite
	PR fortran/122766
	* gfortran.dg/pdt_69.f03: New test.

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 03134f39a404f7bfdbdfe87a60d168d53b86c912..1346f329e612b544836cbab82af52a6c2c8dfadf 100644 (file)
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4824,6 +4824,31 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
        return m;
     }
 
+  /* This picks up function declarations with a PDT typespec. Since a
+     pdt_type has been generated, there is no more to do. Within the
+     function body, this type must be used for the typespec so that
+     the "being used before it is defined warning" does not arise.  */
+  if (ts->type == BT_DERIVED
+      && sym && sym->attr.pdt_type
+      && (gfc_current_state () == COMP_CONTAINS
+         || (gfc_current_state () == COMP_FUNCTION
+             && gfc_current_block ()->ts.type == BT_DERIVED
+             && gfc_current_block ()->ts.u.derived == sym
+             && !gfc_find_symtree (gfc_current_ns->sym_root,
+                                   sym->name))))
+    {
+      if (gfc_current_state () == COMP_FUNCTION)
+       {
+         gfc_symtree *pdt_st;
+         pdt_st = gfc_new_symtree (&gfc_current_ns->sym_root,
+                                   sym->name);
+         pdt_st->n.sym = sym;
+         sym->refs++;
+       }
+      ts->u.derived = sym;
+      return MATCH_YES;
+    }
+
   /* Defer association of the derived type until the end of the
      specification block.  However, if the derived type can be
      found, add it to the typespec.  */
@@ -4860,7 +4885,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
        dt_sym = gfc_find_dt_in_generic (sym);
 
       /* Host associated PDTs can get confused with their constructors
-        because they ar instantiated in the template's namespace.  */
+        because they are instantiated in the template's namespace.  */
       if (!dt_sym)
        {
          if (gfc_find_symbol (dt_name, NULL, 1, &dt_sym))

diff --git a/gcc/testsuite/gfortran.dg/pdt_69.f03 b/gcc/testsuite/gfortran.dg/pdt_69.f03
new file mode 100644 (file)
index 0000000..6217337
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_69.f03
@@ -0,0 +1,58 @@
+! { dg-do compile }
+!
+! Test the fix for PR12276.
+! Exmple from F2018: C.2.5 Structure constructors and generic names
+! Failed in each of the functions with, for example:
+! "Derived type ‘pdtt_4’ at (1) is being used before it is defined"
+! For each of the functions, if the function type was declared within
+! the function, all was well.
+!
+MODULE m
+  TYPE t(kind)
+  INTEGER, KIND :: kind
+  COMPLEX(kind) value
+  END TYPE
+  INTEGER,PARAMETER :: single = KIND(0.0), double = KIND(0d0)
+
+  INTERFACE t
+    MODULE PROCEDURE real_to_t1, dble_to_t2, int_to_t1, int_to_t2
+  END INTERFACE
+
+  CONTAINS
+    TYPE(t(single)) FUNCTION real_to_t1(x)
+    REAL(single) x
+    real_to_t1%value = x
+  END FUNCTION
+
+  TYPE(t(double)) FUNCTION dble_to_t2(x)
+    REAL(double) x
+    dble_to_t2%value = x
+  END FUNCTION
+  TYPE(t(single)) FUNCTION int_to_t1(x,mold)
+    INTEGER x
+    TYPE(t(single)) mold
+    int_to_t1%value = x
+  END FUNCTION
+  TYPE(t(double)) FUNCTION int_to_t2(x,mold)
+    INTEGER x
+    TYPE(t(double)) mold
+      int_to_t2%value = x
+  END FUNCTION
+
+  END
+
+  PROGRAM example
+    USE m
+    TYPE(t(single)) x
+    TYPE(t(double)) y
+    x = t(1.5) ! References real_to_t1
+    print *, x%value
+    x = t(17,mold=x) ! References int_to_t1
+    print *, x%value
+    y = t(1.5d0) ! References dble_to_t2
+    print *, y%value
+    y = t(42,mold=y) ! References int_to_t2
+    print *, y%value
+    y = t(kind(0d0)) ((0,1)) ! Uses the structure constructor for type t
+    print *, y%value
+  END