[fortran] PRs 122578, 122669, 122670 & 122693

diff --git a/gcc/fortran/array.cc b/gcc/fortran/array.cc
index 359d743a632..471f0cb9f3a 100644
--- a/gcc/fortran/array.cc
+++ b/gcc/fortran/array.cc
@@ -1344,6 +1344,7 @@  gfc_match_array_constructor (gfc_expr **result)
   match m;
   const char *end_delim;
   bool seen_ts;
+  gfc_namespace *old_ns = gfc_current_ns;
 
   head = NULL;
   seen_ts = false;
@@ -1368,6 +1369,8 @@  gfc_match_array_constructor (gfc_expr **result)
   /* Try to match an optional "type-spec ::"  */
   gfc_clear_ts (&ts);
   m = gfc_match_type_spec (&ts);
+  gfc_current_ns = old_ns;
+
   if (m == MATCH_YES)
     {
       seen_ts = (gfc_match (" ::") == MATCH_YES);
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 20260ec57ce..dfedb962bad 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -3969,6 +3969,7 @@  gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
   gfc_expr *kind_expr;
   gfc_component *c1, *c2;
   match m;
+  gfc_symtree *s = NULL;
 
   type_param_spec_list = NULL;
 
@@ -4178,10 +4179,29 @@  gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym,
       goto error_return;
     }
 
+  /* If we are in an interface body, the instance will not have been imported.
+     Make sure that it is imported implicitly.  */
+  s = gfc_find_symtree (gfc_current_ns->sym_root, pdt->name);
+  if (gfc_current_ns->proc_name
+      && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
+      && s && s->import_only && pdt->attr.imported)
+    {
+      s = gfc_find_symtree (gfc_current_ns->sym_root, instance->name);
+      if (!s)
+	{
+	  gfc_get_sym_tree (instance->name, gfc_current_ns, &s, false,
+			    &gfc_current_locus);
+	  s->n.sym = instance;
+	}
+      s->n.sym->attr.imported = 1;
+      s->import_only = 1;
+    }
+
   m = MATCH_YES;
 
   if (instance->attr.flavor == FL_DERIVED
-      && instance->attr.pdt_type)
+      && instance->attr.pdt_type
+      && instance->components)
     {
       instance->refs++;
       if (ext_param_list)
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index 262f72b8e7c..9b845b5d57e 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -5842,6 +5842,20 @@  read_module (void)
 		  || startswith (name, "__vtype_")))
 	    p = name;
 
+	  /* Include pdt_types if their associated pdt_template is in a
+	     USE, ONLY list.  */
+	  if (p == NULL && name[0] == 'P'
+	      && startswith (name, "Pdt")
+	      && module_list)
+	    {
+	      gfc_use_list *ml = module_list;
+	      for (; ml; ml = ml->next)
+		if (ml->rename
+		    && !strncmp (&name[3], ml->rename->use_name,
+				 strlen (ml->rename->use_name)))
+		  p = name;
+	    }
+
 	  /* Skip symtree nodes not in an ONLY clause, unless there
 	     is an existing symtree loaded from another USE statement.  */
 	  if (p == NULL)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 729e3b523fa..e5e84e897ff 100644
--- a/gcc/fortran/primary.cc
+++ b/gcc/fortran/primary.cc
@@ -2261,6 +2261,32 @@  gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       && !sym->attr.select_rank_temporary)
     inferred_type = true;
 
+  /* Try to resolve a typebound generic procedure so that the associate name
+     has a chance to get a type before being used in a second, nested associate
+     statement. Note that a copy is used for resolution so that failure does
+     not result in a mutilated selector expression further down the line.  */
+  if (tgt_expr && !sym->assoc->dangling
+      && tgt_expr->ts.type == BT_UNKNOWN
+      && tgt_expr->symtree
+      && tgt_expr->symtree->n.sym
+      && gfc_expr_attr (tgt_expr).generic
+      && ((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.pdt_template)
+	  || (sym->ts.type == BT_CLASS
+	      && CLASS_DATA (sym)->ts.u.derived->attr.pdt_template)))
+    {
+	gfc_expr *cpy = gfc_copy_expr (tgt_expr);
+	if (gfc_resolve_expr (cpy)
+	    && cpy->ts.type != BT_UNKNOWN)
+	  {
+	    gfc_replace_expr (tgt_expr, cpy);
+	    sym->ts = tgt_expr->ts;
+	  }
+	else
+	  gfc_free_expr (cpy);
+	if (gfc_expr_attr (tgt_expr).generic)
+	  inferred_type = true;
+    }
+
   /* For associate names, we may not yet know whether they are arrays or not.
      If the selector expression is unambiguously an array; eg. a full array
      or an array section, then the associate name must be an array and we can
@@ -2493,6 +2519,20 @@  gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
 	       && !gfc_find_derived_types (sym, gfc_current_ns, name))
 	primary->ts.type = BT_UNKNOWN;
 
+      /* Otherwise try resolving a copy of a component call. If it succeeds,
+	 use that for the selector expression.  */
+      else if (tgt_expr && tgt_expr->expr_type == EXPR_COMPCALL)
+	  {
+	     gfc_expr *cpy = gfc_copy_expr (tgt_expr);
+	     if (gfc_resolve_expr (cpy))
+		{
+		  gfc_replace_expr (tgt_expr, cpy);
+		  sym->ts = tgt_expr->ts;
+		}
+	      else
+		gfc_free_expr (cpy);
+	  }
+
       /* An inquiry reference might determine the type, otherwise we have an
 	 error.  */
       if (sym->ts.type == BT_UNKNOWN && !inquiry)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 9f3ce1d2ad6..c2f53fc9ecc 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9799,8 +9799,10 @@  done_errmsg:
       /* Resolving the expr3 in the loop over all objects to allocate would
 	 execute loop invariant code for each loop item.  Therefore do it just
 	 once here.  */
+      mpz_t nelem;
       if (code->expr3 && code->expr3->mold
-	  && code->expr3->ts.type == BT_DERIVED)
+	  && code->expr3->ts.type == BT_DERIVED
+	  && !(code->expr3->ref && gfc_array_size (code->expr3, &nelem)))
 	{
 	  /* Default initialization via MOLD (non-polymorphic).  */
 	  gfc_expr *rhs = gfc_default_initializer (&code->expr3->ts);
diff --git a/gcc/testsuite/gfortran.dg/pdt_72.f03 b/gcc/testsuite/gfortran.dg/pdt_72.f03
new file mode 100644
index 00000000000..57640bd0200
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_72.f03
@@ -0,0 +1,110 @@ 
+! { dg-do compile }
+!
+! Tests the fix for pr122578, which failed in compilation with the errors
+! shown below.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_map_m
+  use iso_c_binding, only :  c_int
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(1.)
+    real(k), allocatable :: values_(:) ! Error: Cannot convert REAL(0) to REAL(4) at (1)
+  contains
+    generic   :: values => default_real_values
+    procedure default_real_values
+  end type
+
+  interface
+    pure module function default_real_values(self) result(tensor_values)
+      implicit none
+      class(tensor_t), intent(in) :: self
+      real, allocatable :: tensor_values(:)
+    end function
+  end interface
+
+  type tensor_map_t(k)
+    integer, kind :: k = kind(1.)
+    real(k), dimension(:), allocatable :: intercept_, slope_
+  contains
+    generic :: map_to_training_range    => default_real_map_to_training_range
+    procedure :: default_real_map_to_training_range
+    generic :: map_from_training_range  => default_real_map_from_training_range
+    procedure :: default_real_map_from_training_range
+  end type
+
+  interface
+    elemental module function default_real_map_to_training_range(self, tensor) result(normalized_tensor)
+      implicit none
+      class(tensor_map_t), intent(in) :: self
+      type(tensor_t), intent(in) :: tensor
+      type(tensor_t) normalized_tensor
+    end function
+
+    elemental module function default_real_map_from_training_range(self, tensor) result(unnormalized_tensor)
+      implicit none
+      class(tensor_map_t), intent(in) :: self
+      type(tensor_t), intent(in) :: tensor
+      type(tensor_t) unnormalized_tensor
+    end function
+  end interface
+
+  type activation_t
+    integer(c_int) :: selection_
+  contains
+    generic :: evaluate => default_real_evaluate
+    procedure default_real_evaluate
+  end type
+
+  interface
+    elemental module function default_real_evaluate(self, x) result(y)
+      implicit none
+      class(activation_t), intent(in) :: self
+      real, intent(in) :: x 
+      real y 
+    end function
+  end interface
+
+  type neural_network_t(k)
+    integer, kind :: k = kind(1.)
+    type(tensor_map_t(k)) input_map_, output_map_
+    real(k), allocatable :: weights_(:,:,:), biases_(:,:)
+    integer, allocatable :: nodes_(:)
+    type(activation_t) :: activation_
+  contains
+    generic :: infer => default_real_infer
+    procedure default_real_infer
+  end type
+
+  integer, parameter :: input_layer = 0 
+contains
+  elemental function default_real_infer(self, inputs) result(outputs)
+    class(neural_network_t), intent(in) :: self
+    type(tensor_t), intent(in) :: inputs
+    type(tensor_t) outputs
+    real, allocatable :: a(:,:)
+    integer l
+    associate(w => self%weights_, b => self%biases_, n => self%nodes_, output_layer => ubound(self%nodes_,1))
+      allocate(a(maxval(n), input_layer:output_layer))
+      associate(normalized_inputs => self%input_map_%map_to_training_range(inputs))
+        a(1:n(input_layer),input_layer) = normalized_inputs%values() ! Error: Symbol ‘normalized_inputs’
+                                                                     ! at (1) has no IMPLICIT type
+
+      end associate
+      feed_forward: &
+      do l = input_layer+1, output_layer
+        associate(z => matmul(w(1:n(l),1:n(l-1),l), a(1:n(l-1),l-1)) + b(1:n(l),l))
+          a(1:n(l),l) = self%activation_%evaluate(z)
+        end associate
+      end do feed_forward
+      associate(normalized_outputs => tensor_t(a(1:n(output_layer), output_layer)))
+        outputs = self%output_map_%map_from_training_range(normalized_outputs) ! Error: Found no matching specific
+                                                                               ! binding for the call to the GENERIC
+                                                                               ! ‘map_from_training_range’ at (1)
+
+      end associate
+    end associate
+  end function
+end module
diff --git a/gcc/testsuite/gfortran.dg/pdt_73.f03 b/gcc/testsuite/gfortran.dg/pdt_73.f03
new file mode 100644
index 00000000000..63a92342a67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_73.f03
@@ -0,0 +1,18 @@ 
+! { dg-do compile }
+!
+! Tests the fix for pr122669, which falied with the error below.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+  implicit none
+  type tensor_t
+    real, allocatable :: values_
+  end type
+  type(tensor_t) :: random_inputs(1)
+  type(tensor_t), allocatable :: outputs(:)
+
+  random_inputs = [tensor_t(1.0)]
+  allocate(outputs, mold=random_inputs) ! Error: Array specification or array-valued
+                                        ! SOURCE= expression required in ALLOCATE statement at (1)
+  print *, size(outputs)
+end 
diff --git a/gcc/testsuite/gfortran.dg/pdt_74.f03 b/gcc/testsuite/gfortran.dg/pdt_74.f03
new file mode 100644
index 00000000000..c12db790bd1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_74.f03
@@ -0,0 +1,48 @@ 
+! { dg-do compile }
+!
+! Tests the fix for pr122670, where use only did not compile for PDTs. Also, it
+! was found in the course of developing the fix that import only did not work
+! either.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_m
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(0.)
+    real(k), allocatable :: value_
+  end type
+
+  interface
+    function myfunc (arg)
+      import tensor_t
+      implicit none
+      type (tensor_t) myfunc
+      type (tensor_t), intent(in) :: arg
+    end function
+  end interface
+
+contains
+  function y(x)
+    type(tensor_t) x, y
+    y = tensor_t(x%value_)
+  end function
+end module
+
+function myfunc (arg)
+  use tensor_m, only : tensor_t
+  implicit none
+  type (tensor_t) myfunc
+  type (tensor_t), intent(in) :: arg
+  myfunc = arg
+  myfunc%value_ = myfunc%value_ * 2.0
+end function
+
+  use tensor_m, only : tensor_t, y, myfunc
+  implicit none
+  type(tensor_t) desired_output
+  desired_output = y(tensor_t(42.))
+  desired_output = myfunc (desired_output)
+  print *, desired_output%value_
+end
diff --git a/gcc/testsuite/gfortran.dg/pdt_75.f03 b/gcc/testsuite/gfortran.dg/pdt_75.f03
new file mode 100644
index 00000000000..f70087136c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pdt_75.f03
@@ -0,0 +1,35 @@ 
+! { dg-do compile }
+!
+! Tests the fix for pr122693, which failed in compilation with the errors
+! shown below.
+!
+! Contributed by Damian Rouson  <damian@archaeologic.codes>
+!
+module tensor_m
+  implicit none
+
+  type tensor_t(k)
+    integer, kind :: k = kind(0.)
+  end type
+
+  interface tensor_t
+    module function tensor(unused_stuff)
+      implicit none
+      real unused_stuff
+      type(tensor_t) tensor
+    end function
+  end interface
+
+end module
+
+  use tensor_m
+  implicit none
+contains
+  function test_passed()
+    logical test_passed
+    type(tensor_t), allocatable :: tensor_array(:)
+    real, parameter :: junk = 0.
+    tensor_array = [tensor_t(junk)] !Error: Symbol ‘junk’ at (1) has no IMPLICIT type
+    test_passed =  .false.          !Error: ‘test_passed’ at (1) is not a variable
+  end function
+end