https://gcc.gnu.org/g:9fbaf3fad8b1ae30eb3b53b4b3b2d95bfea82806
commit 9fbaf3fad8b1ae30eb3b53b4b3b2d95bfea82806
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Thu Sep 25 10:45:07 2025 +0200
Revert "Fortran: Implement PDT constructors with syntax variants [PR114815]"
This reverts commit c52c745c98f846308ad18a6d49da541cebb0a8b3.
Diff:
---
gcc/fortran/decl.cc | 2 +-
gcc/fortran/primary.cc | 53 ++++++++++--------------------------
gcc/fortran/resolve.cc | 7 -----
gcc/testsuite/gfortran.dg/pdt_17.f03 | 2 +-
gcc/testsuite/gfortran.dg/pdt_3.f03 | 1 -
gcc/testsuite/gfortran.dg/pdt_47.f03 | 50 ----------------------------------
6 files changed, 16 insertions(+), 99 deletions(-)
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 102c6a8e8df8..072ff8dbd14c 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -4092,7 +4092,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list,
gfc_symbol **sym,
if (c1->tb)
{
c2->tb = gfc_get_tbp ();
- *c2->tb = *c1->tb;
+ c2->tb = c1->tb;
}
/* The order of declaration of the type_specs might not be the
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 638018bcce37..2cb930d83b8c 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -4059,7 +4059,7 @@ gfc_match_rvalue (gfc_expr **result)
/* Check to see if this is a PDT constructor. The format of these
constructors is rather unusual:
- name [(type_params)](component_values)
+ name (type_params)(component_values)
where, component_values excludes the type_params. With the present
gfortran representation this is rather awkward because the two are not
distinguished, other than by their attributes. */
@@ -4074,15 +4074,7 @@ gfc_match_rvalue (gfc_expr **result)
gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st);
if (pdt_st && pdt_st->n.sym && pdt_st->n.sym->attr.pdt_template)
{
- bool type_spec_list = false;
pdt_sym = pdt_st->n.sym;
- gfc_gobble_whitespace ();
- /* Look for a second actual arglist. If present, try the first
- for the type parameters. Otherwise, or if there is no match,
- depend on default values by setting the type parameters to
- NULL. */
- if (gfc_peek_ascii_char() == '(')
- type_spec_list = true;
/* Generate this instance using the type parameters from the
first argument list and return the parameter list in
@@ -4090,27 +4082,15 @@ gfc_match_rvalue (gfc_expr **result)
m = gfc_get_pdt_instance (actual_arglist, &pdt_sym, &ctr_arglist);
if (m != MATCH_YES)
{
- if (ctr_arglist)
- gfc_free_actual_arglist (ctr_arglist);
- /* See if all the type parameters have default values. */
- m = gfc_get_pdt_instance (NULL, &pdt_sym, &ctr_arglist);
- if (m != MATCH_YES)
- {
- m = MATCH_NO;
- break;
- }
+ m = MATCH_ERROR;
+ break;
}
-
- /* Now match the component_values if the type parameters were
- present. */
- if (type_spec_list)
+ /* Now match the component_values. */
+ m = gfc_match_actual_arglist (0, &actual_arglist);
+ if (m != MATCH_YES)
{
- m = gfc_match_actual_arglist (0, &actual_arglist);
- if (m != MATCH_YES)
- {
- m = MATCH_ERROR;
- break;
- }
+ m = MATCH_ERROR;
+ break;
}
/* Make sure that the component names are in place so that this
@@ -4124,18 +4104,13 @@ gfc_match_rvalue (gfc_expr **result)
tmp = tmp->next;
}
- gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name),
- NULL, 1, &symtree);
- if (!symtree)
- {
- gfc_get_ha_sym_tree (gfc_dt_lower_string (pdt_sym->name) ,
- &symtree);
- symtree->n.sym = pdt_sym;
- symtree->n.sym->ts.u.derived = pdt_sym;
- symtree->n.sym->ts.type = BT_DERIVED;
- }
+ gfc_get_ha_sym_tree (gfc_dt_lower_string (pdt_sym->name) ,
+ &symtree);
+ symtree->n.sym = pdt_sym;
+ symtree->n.sym->ts.u.derived = pdt_sym;
+ symtree->n.sym->ts.type = BT_DERIVED;
- /* Append the type_params and the component_values. */
+ /* Do the appending. */
for (tmp = ctr_arglist; tmp && tmp->next;)
tmp = tmp->next;
tmp->next = actual_arglist;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index daff3b3e33ba..b83961fe6f10 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -14613,13 +14613,6 @@ build_init_assign (gfc_symbol *sym, gfc_expr *init)
gfc_code *init_st;
gfc_namespace *ns = sym->ns;
- if (sym->attr.function && sym->result == sym
- && sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_type)
- {
- gfc_free_expr (init);
- return;
- }
-
/* Search for the function namespace if this is a contained
function without an explicit result. */
if (sym->attr.function && sym == sym->result
diff --git a/gcc/testsuite/gfortran.dg/pdt_17.f03
b/gcc/testsuite/gfortran.dg/pdt_17.f03
index d03e2d139a02..1b0a30dca4cb 100644
--- a/gcc/testsuite/gfortran.dg/pdt_17.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_17.f03
@@ -6,6 +6,6 @@
!
program p
type t(a) ! { dg-error "does not have a component" }
- integer(kind=t()) :: x ! { dg-error "Expected initialization
expression" }
+ integer(kind=t()) :: x ! { dg-error "used before it is defined" }
end type
end
diff --git a/gcc/testsuite/gfortran.dg/pdt_3.f03
b/gcc/testsuite/gfortran.dg/pdt_3.f03
index 68007689aec3..cd48364b1534 100644
--- a/gcc/testsuite/gfortran.dg/pdt_3.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_3.f03
@@ -76,5 +76,4 @@ end module
end select
deallocate (cz)
- deallocate (matrix)
end
diff --git a/gcc/testsuite/gfortran.dg/pdt_47.f03
b/gcc/testsuite/gfortran.dg/pdt_47.f03
deleted file mode 100644
index f3b77d9555fc..000000000000
--- a/gcc/testsuite/gfortran.dg/pdt_47.f03
+++ /dev/null
@@ -1,50 +0,0 @@
-! { dg-do run }
-!
-! Test the fix for PR121948, in which the PDT constructor expressions without
-! the type specification list, ie. relying on default values, failed. The fix
-! also required that the incorrect initialization of functions with implicit
-! function result be eliminated.
-!
-! Contributed by Damian Rouson <damian@archaeologic.codes>
-!
- implicit none
-
- integer, parameter :: dp = kind(1d0)
- real, parameter :: ap = 42.0
- real(dp), parameter :: ap_d = 42.0d0
-
- type operands_t(k)
- integer, kind :: k = kind(1.)
- real(k) :: actual, expected
- end type
-
- type(operands_t) :: x
- type(operands_t(dp)) :: y
-
- x = operands (ap, 10 * ap)
- if (abs (x%actual - ap) >1e-5) stop 1
- if (abs (x%expected - 10 * ap) > 1e-5) stop 2
-
-
- y = operands_dp (ap_d, 10d0 * ap_d)
- if (abs (y%actual - ap_d) > 1d-10) stop 3
- if (abs (y%expected - 10d0 * ap_d) > 1d-10) stop 4
- if (kind (y%actual) /= dp) stop 5
- if (kind (y%expected) /= dp) stop 6
-
-contains
-
- function operands(actual, expected) ! Use the default 'k'
- real actual, expected
- type(operands_t) :: operands
- operands = operands_t(actual, expected)
- end function
-
-
- function operands_dp(actual, expected) ! Override the default
- real(dp) actual, expected
- type(operands_t(dp)) :: operands_dp
- operands_dp = operands_t(dp)(actual, expected)
- end function
-
-end
