Patchwork [Fortran] PR39427/37829 - implement F2003's constructors

login
register
mail settings
Submitter Tobias Burnus
Date Nov. 6, 2011, 4:28 p.m.
Message ID <4EB6B5B5.7030607@net-b.de>
Download mbox | patch
Permalink /patch/123942/
State New
Headers show

Comments

Tobias Burnus - Nov. 6, 2011, 4:28 p.m.
Am 06.11.2011 17:26, schrieb Tobias Burnus:
> I just realized that my patch email did not come through - however, I 
> did not get any reject email.
  And now again with patches ... Stupid mailserver!

Tobias

Patch

[Remark: The delected section in resolve_symbol with gfc_find_symbol(..&ds)
 was originally added in r133488 for PR fortran/33295]

gcc/fortran
2011-11-06  Tobias Burnus  <burnus@net-b.de>

	* symbol.c
	SEE SEPARATE PATCH AT: http://gcc.gnu.org/ml/fortran/2011-11/msg00026.html
	(clear_sym_mark, traverse_ns): Remove functions.
	(count_st_nodes, do_traverse_symtree, fill_st_vector): New functions.
	(gfc_traverse_symtree, gfc_traverse_ns): Call do_traverse_symtree.

	PR fortran/39427
	PR fortran/37829
	* decl.c (match_data_constant, match_data_constant, variable_decl,
	gfc_match_decl_type_spec, access_attr_decl,
	check_extended_derived_type, gfc_match_derived_decl,
	gfc_match_derived_decl, gfc_match_derived_decl) Modified to deal
	with DT constructors.
	* gfortran.h (gfc_find_dt_in_generic,
	gfc_convert_to_structure_constructor): New function prototypes.
	* interface.c (check_interface0, check_interface1,
	gfc_search_interface): Ignore DT constructors in generic list.
	* match.h (gfc_match_structure_constructor): Update prototype.
	* match.c (match_derived_type_spec): Ensure that one uses the DT
	not the generic function.
	* module.c (MOD_VERSION): Bump.
	(dt_lower_string, dt_upper_string): New functions.
	(find_use_name_n, find_use_operator, compare_true_names,
	find_true_name, add_true_name, fix_mio_expr, load_needed,
	read_module, write_dt_extensions, write_symbol): Changes to deal with
	different symtree vs. sym names.
	(create_derived_type): Create also generic procedure.
	* parse.c (gfc_fixup_sibling_symbols): Don't regard DT and generic
	function as the same.
	* primary.c (gfc_convert_to_structure_constructor): New function.
	(gfc_match_structure_constructor): Restructured; calls
	gfc_convert_to_structure_constructor.
	(build_actual_constructor, gfc_match_rvalue): Update for DT generic
	functions.
	* resolve.c (resolve_formal_arglist, resolve_structure_cons,
	is_illegal_recursion, resolve_generic_f, resolve_variable,
	resolve_fl_variable_derived, resolve_fl_derived0,
	resolve_symbol): Handle DT and DT generic constructors.
	* symbol.c (gfc_use_derived, gfc_undo_symbols,
	gen_special_c_interop_ptr, gen_cptr_param,
	generate_isocbinding_symbol, gfc_get_derived_super_type): Handle
	derived-types, which are hidden in the generic type.
	(gfc_find_dt_in_generic): New function
	* trans-array.c (gfc_conv_array_initializer): Replace FL_PARAMETER
	expr by actual value.
	* trans-decl.c (gfc_get_module_backend_decl, gfc_trans_use_stmts):
	Ensure that we use the DT and not the generic function.
	* trans-types.c (gfc_get_derived_type): Ensure that we use the DT
	and not the generic procedure.

gcc/testsuite/
2011-11-06  Tobias Burnus  <burnus@net-b.de>

	PR fortran/39427
	PR fortran/37829
	* gfortran.dg/constructor_1.f90: New.
	* gfortran.dg/constructor_2.f90: New.
	* gfortran.dg/constructor_3.f90: New.
	* gfortran.dg/constructor_4.f90: New.
	* gfortran.dg/constructor_5.f90: New.
	* gfortran.dg/constructor_6.f90: New.
	* gfortran.dg/use_only_5.f90: New.
	* gfortran.dg/c_ptr_tests_17.f90: New.
	* gfortran.dg/c_ptr_tests_18.f90: New.
	* gfortran.dg/used_types_25.f90: New.
	* gfortran.dg/used_types_26.f90: New
	* gfortran.dg/type_decl_3.f90: New.
	* gfortran.dg/function_types_3.f90: Update dg-error.
	* gfortran.dg/result_1.f90: Ditto.
	* gfortran.dg/structure_constructor_3.f03: Ditto.
	* gfortran.dg/structure_constructor_4.f03: Ditto.


 fortran/decl.c                                    |  171 +++++++++--
 fortran/gfortran.h                                |    4 
 fortran/interface.c                               |   26 +
 fortran/match.c                                   |    3 
 fortran/match.h                                   |    2 
 fortran/module.c                                  |  106 +++++-
 fortran/parse.c                                   |    6 
 fortran/primary.c                                 |  339 ++++++++++++----------
 fortran/resolve.c                                 |  107 +++++-
 fortran/symbol.c                                  |  309 +++++++++++++-------
 fortran/trans-array.c                             |    5 
 fortran/trans-decl.c                              |   25 +
 fortran/trans-types.c                             |    4 
 testsuite/gfortran.dg/c_ptr_tests_17.f90          |   88 +++++
 testsuite/gfortran.dg/c_ptr_tests_18.f90          |   35 ++
 testsuite/gfortran.dg/constructor_1.f90           |   42 ++
 testsuite/gfortran.dg/constructor_2.f90           |   73 ++++
 testsuite/gfortran.dg/constructor_3.f90           |   47 +++
 testsuite/gfortran.dg/constructor_4.f90           |   33 ++
 testsuite/gfortran.dg/constructor_5.f90           |   34 ++
 testsuite/gfortran.dg/constructor_6.f90           |  171 +++++++++++
 testsuite/gfortran.dg/function_types_3.f90        |    2 
 testsuite/gfortran.dg/result_1.f90                |    7 
 testsuite/gfortran.dg/structure_constructor_3.f03 |    2 
 testsuite/gfortran.dg/structure_constructor_4.f03 |    2 
 testsuite/gfortran.dg/type_decl_3.f90             |    7 
 testsuite/gfortran.dg/use_only_5.f90              |   38 ++
 testsuite/gfortran.dg/used_types_25.f90           |   17 +
 testsuite/gfortran.dg/used_types_26.f90           |   22 +
 29 files changed, 1402 insertions(+), 325 deletions(-)


Index: gcc/testsuite/gfortran.dg/constructor_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/constructor_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/constructor_1.f90	(Revision 0)
@@ -0,0 +1,42 @@ 
+! { dg-do compile }
+!
+! PR fortran/39427
+!
+! Check constructor functionality.
+!
+! Contributed by Damian Rouson.
+!
+module mycomplex_module
+   private
+   public :: mycomplex
+   type mycomplex
+!      private
+      real :: argument, modulus
+   end type
+   interface mycomplex
+      module procedure complex_to_mycomplex, two_reals_to_mycomplex
+   end interface
+!   :
+   contains
+      type(mycomplex) function complex_to_mycomplex(c)
+         complex, intent(in) :: c
+!         :
+      end function complex_to_mycomplex
+      type(mycomplex) function two_reals_to_mycomplex(x,y)
+         real, intent(in)           :: x
+         real, intent(in), optional :: y
+!         :
+       end function two_reals_to_mycomplex
+!       :
+    end module mycomplex_module
+!    :
+program myuse
+    use mycomplex_module
+    type(mycomplex) :: a, b, c
+!    :
+    a = mycomplex(argument=5.6, modulus=1.0)  ! The structure constructor
+    c = mycomplex(x=0.0, y=1.0)               ! A function reference
+    c = mycomplex(0.0, 1.0)               ! A function reference
+end program myuse
+
+! { dg-final { cleanup-modules "mycomplex_module" } }
Index: gcc/testsuite/gfortran.dg/use_only_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/use_only_5.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/use_only_5.f90	(Revision 0)
@@ -0,0 +1,38 @@ 
+! { dg-do compile }
+!
+! PR fortran/39427
+!
+! Test case was failing with the initial version of the
+! constructor patch.
+!
+! Based on the Fortran XML library FoX
+
+module m_common_attrs
+  implicit none
+  private
+
+  type dict_item
+    integer, allocatable :: i(:)
+  end type dict_item
+
+  type dictionary_t
+    private
+    type(dict_item), pointer :: d => null()
+  end type dictionary_t
+
+  public :: dictionary_t
+  public :: get_prefix_by_index
+
+contains
+  pure function get_prefix_by_index(dict) result(prefix)
+    type(dictionary_t), intent(in) :: dict
+    character(len=size(dict%d%i)) :: prefix
+  end function get_prefix_by_index
+end module m_common_attrs
+
+module m_common_namespaces
+  use m_common_attrs, only: dictionary_t
+  use m_common_attrs, only: get_prefix_by_index
+end module m_common_namespaces
+
+! { dg-final { cleanup-modules "m_common_attrs m_common_namespaces" } }
Index: gcc/testsuite/gfortran.dg/constructor_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/constructor_3.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/constructor_3.f90	(Revision 0)
@@ -0,0 +1,47 @@ 
+! { dg-do run }
+!
+! PR fortran/39427
+!
+! Check constructor functionality.
+!
+!
+module m
+  interface cons
+    procedure cons42
+  end interface cons
+contains
+  integer function cons42()
+    cons42 = 42
+  end function cons42
+end module m
+
+
+module m2
+  type cons
+    integer :: j = -1
+  end type cons
+  interface cons
+    procedure consT
+  end interface cons
+contains
+  type(cons) function consT(k)
+    integer :: k
+    consT%j = k**2
+  end function consT
+end module m2
+
+
+use m
+use m2, only: cons
+implicit none
+type(cons) :: x
+integer :: k
+x = cons(3)
+k = cons()
+if (x%j /= 9) call abort ()
+if (k /= 42) call abort ()
+!print *, x%j
+!print *, k
+end
+
+! { dg-final { cleanup-modules "m m2" } }
Index: gcc/testsuite/gfortran.dg/c_ptr_tests_17.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests_17.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests_17.f90	(Revision 0)
@@ -0,0 +1,88 @@ 
+! { dg-do compile }
+!
+! PR fortran/37829
+!
+! Contributed by James Van Buskirk and Jerry DeLisle.
+!
+! Fix derived-type loading with ISO_BIND_C's C_PTR/C_FUNPTR.
+
+module m3
+   use ISO_C_BINDING
+   implicit none
+   private
+
+   public kill_C_PTR
+   interface
+      function kill_C_PTR() bind(C)
+         import
+         implicit none
+         type(C_PTR) kill_C_PTR
+      end function kill_C_PTR
+   end interface
+
+   public kill_C_FUNPTR
+   interface
+      function kill_C_FUNPTR() bind(C)
+         import
+         implicit none
+         type(C_FUNPTR) kill_C_FUNPTR
+      end function kill_C_FUNPTR
+   end interface
+end module m3
+
+module m1
+   use m3
+end module m1
+
+program X
+   use m1
+   use ISO_C_BINDING
+   implicit none
+   type(C_PTR) cp
+   type(C_FUNPTR) fp
+   integer(C_INT),target :: i
+   interface
+      function fun() bind(C)
+         use ISO_C_BINDING
+         implicit none
+         real(C_FLOAT) fun
+      end function fun
+   end interface
+
+   cp = C_NULL_PTR
+   cp = C_LOC(i)
+   fp = C_NULL_FUNPTR
+   fp = C_FUNLOC(fun)
+end program X
+
+function fun() bind(C)
+   use ISO_C_BINDING
+   implicit none
+   real(C_FLOAT) fun
+   fun = 1.0
+end function fun
+
+function kill_C_PTR() bind(C)
+   use ISO_C_BINDING
+   implicit none
+   type(C_PTR) kill_C_PTR
+   integer(C_INT), pointer :: p
+   allocate(p)
+   kill_C_PTR = C_LOC(p)
+end function kill_C_PTR
+
+function kill_C_FUNPTR() bind(C)
+   use ISO_C_BINDING
+   implicit none
+   type(C_FUNPTR) kill_C_FUNPTR
+   interface
+      function fun() bind(C)
+         use ISO_C_BINDING
+         implicit none
+         real(C_FLOAT) fun
+      end function fun
+   end interface
+   kill_C_FUNPTR = C_FUNLOC(fun)
+end function kill_C_FUNPTR
+
+! { dg-final { cleanup-modules "m3 m1" } }
Index: gcc/testsuite/gfortran.dg/constructor_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/constructor_5.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/constructor_5.f90	(Revision 0)
@@ -0,0 +1,34 @@ 
+! { dg-do compile }
+!
+! PR fortran/39427
+!
+! Check constructor functionality.
+!
+!
+module m
+  type t
+    integer :: x
+  end type t
+  interface t
+    module procedure f
+  end interface t
+contains
+  function f()
+    type(t) :: f
+  end function
+end module
+
+module m2
+  interface t2
+    module procedure f2
+  end interface t2
+  type t2
+    integer :: x2
+  end type t2
+contains
+  function f2()
+    type(t2) :: f2
+  end function
+end module
+
+! { dg-final { cleanup-modules "m m2" } }
Index: gcc/testsuite/gfortran.dg/structure_constructor_3.f03
===================================================================
--- gcc/testsuite/gfortran.dg/structure_constructor_3.f03	(Revision 181028)
+++ gcc/testsuite/gfortran.dg/structure_constructor_3.f03	(Arbeitskopie)
@@ -13,6 +13,6 @@  PROGRAM test
 
   TYPE(basics_t) :: basics
 
-  basics = basics_t (i=42, 1.5) ! { dg-error "without name after" }
+  basics = basics_t (i=42, 1.5) ! { dg-error "Missing keyword name" }
 
 END PROGRAM test
Index: gcc/testsuite/gfortran.dg/used_types_25.f90
===================================================================
--- gcc/testsuite/gfortran.dg/used_types_25.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/used_types_25.f90	(Revision 0)
@@ -0,0 +1,17 @@ 
+! { dg-do compile }
+!
+! Created to check this ambiguity when
+! constructors were added. Cf. PR fortran/39427
+
+module m
+  type t
+  end type t
+end module m
+
+use m
+ type t ! { dg-error "Derived type definition of 't' at .1. has already been defined" }
+ end type t ! { dg-error "Expecting END PROGRAM statement" }
+end
+
+! { dg-final { cleanup-modules "m" } }
+
Index: gcc/testsuite/gfortran.dg/function_types_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/function_types_3.f90	(Revision 181028)
+++ gcc/testsuite/gfortran.dg/function_types_3.f90	(Arbeitskopie)
@@ -14,6 +14,6 @@  end
 
 ! PR 50403: SIGSEGV in gfc_use_derived
 
-type(f) function f()  ! { dg-error "conflicts with DERIVED attribute|is not accessible" }
+type(f) function f()  ! { dg-error "Type name 'f' at .1. conflicts with previously declared entity|The type for function 'f' at .1. is not accessible" }
   f=110               ! { dg-error "Unclassifiable statement" }
 end
Index: gcc/testsuite/gfortran.dg/constructor_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/constructor_2.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/constructor_2.f90	(Revision 0)
@@ -0,0 +1,73 @@ 
+! { dg-do run }
+!
+! PR fortran/39427
+!
+module foo_module
+  interface foo
+    procedure constructor
+  end interface
+
+  type foo
+    integer :: bar
+  end type
+contains
+  type(foo) function constructor()
+    constructor%bar = 1
+  end function
+
+  subroutine test_foo()
+    type(foo) :: f
+    f = foo()
+    if (f%bar /= 1) call abort ()
+    f = foo(2)
+    if (f%bar /= 2) call abort ()
+  end subroutine test_foo
+end module foo_module
+
+
+! Same as foo_module but order
+! of INTERFACE and TYPE reversed
+module bar_module
+  type bar
+    integer :: bar
+  end type
+
+  interface bar
+    procedure constructor
+  end interface
+contains
+  type(bar) function constructor()
+    constructor%bar = 3
+  end function
+
+  subroutine test_bar()
+    type(bar) :: f
+    f = bar()
+    if (f%bar /= 3) call abort ()
+    f = bar(4)
+    if (f%bar /= 4) call abort ()
+  end subroutine test_bar
+end module bar_module
+
+program main
+  use foo_module
+  use bar_module
+  implicit none
+
+  type(foo) :: f
+  type(bar) :: b
+
+  call test_foo()
+  f = foo()
+  if (f%bar /= 1) call abort ()
+  f = foo(2)
+  if (f%bar /= 2) call abort ()
+
+  call test_bar()
+  b = bar()
+  if (b%bar /= 3) call abort ()
+  b = bar(4)
+  if (b%bar /= 4) call abort ()
+end program main
+
+! { dg-final { cleanup-tree-dump "foo_module bar_module" } }
Index: gcc/testsuite/gfortran.dg/constructor_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/constructor_4.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/constructor_4.f90	(Revision 0)
@@ -0,0 +1,33 @@ 
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/39427
+!
+! Check constructor functionality.
+!
+!
+module m
+  type t ! { dg-error "the same name as derived type" }
+    integer :: x
+  end type t
+  interface t
+    module procedure f
+  end interface t
+contains
+  function f() ! { dg-error "the same name as derived type" }
+    type(t) :: f
+  end function
+end module
+
+module m2
+  interface t2
+    module procedure f2
+  end interface t2
+  type t2 ! { dg-error "the same name as derived type" }
+    integer :: x2
+  end type t2
+contains
+  function f2() ! { dg-error "the same name as derived type" }
+    type(t2) :: f2
+  end function
+end module
Index: gcc/testsuite/gfortran.dg/c_ptr_tests_18.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_ptr_tests_18.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/c_ptr_tests_18.f90	(Revision 0)
@@ -0,0 +1,35 @@ 
+! { dg-do compile }
+!
+! PR fortran/37829
+! PR fortran/45190
+!
+! Contributed by Mat Cross
+!
+! Fix derived-type loading with ISO_BIND_C's C_PTR/C_FUNPTR.
+
+MODULE NAG_J_TYPES
+  USE ISO_C_BINDING, ONLY : C_PTR
+  IMPLICIT NONE
+  TYPE                            :: NAG_IMAGE
+     INTEGER                      :: WIDTH, HEIGHT, PXFMT, NCHAN
+     TYPE (C_PTR)                 :: PIXELS
+  END TYPE NAG_IMAGE
+END MODULE NAG_J_TYPES
+program cfpointerstress
+  use nag_j_types
+  use iso_c_binding
+  implicit none
+  type(nag_image),pointer :: img
+  type(C_PTR)             :: ptr
+  real, pointer           :: r
+  allocate(r)
+  allocate(img)
+  r = 12
+  ptr = c_loc(img)
+  write(*,*) 'C_ASSOCIATED =', C_ASSOCIATED(ptr)
+  call c_f_pointer(ptr, img)
+  write(*,*) 'ASSOCIATED =', associated(img)
+  deallocate(r)
+end program cfpointerstress
+
+! { dg-final { cleanup-modules "nag_j_types" } }
Index: gcc/testsuite/gfortran.dg/constructor_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/constructor_6.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/constructor_6.f90	(Revision 0)
@@ -0,0 +1,171 @@ 
+! { dg-do run }
+!
+! PR fortran/39427
+!
+! Contributed by Norman S. Clerman (in PR fortran/45155)
+!
+! Constructor test case
+!
+!
+module test_cnt
+  integer, public, save :: my_test_cnt = 0
+end module test_cnt
+
+module Rational
+  use test_cnt
+  implicit none
+  private
+
+  type, public :: rational_t
+    integer :: n = 0, id = 1
+  contains
+    procedure, nopass :: Construct_rational_t
+    procedure :: Print_rational_t
+    procedure, private :: Rational_t_init
+    generic :: Rational_t => Construct_rational_t
+    generic :: print      => Print_rational_t
+  end type rational_t
+
+contains
+
+  function Construct_rational_t (message_) result (return_type)
+    character (*), intent (in) :: message_
+    type (rational_t) :: return_type
+
+!    print *, trim (message_)
+    if (my_test_cnt /= 1) call abort()
+    my_test_cnt = my_test_cnt + 1
+    call return_type % Rational_t_init
+
+  end function Construct_rational_t
+
+  subroutine Print_rational_t (this_)
+    class (rational_t), intent (in) :: this_
+
+!    print *, "n, id", this_% n, this_% id
+    if (my_test_cnt == 0) then
+      if (this_% n /= 0 .or. this_% id /= 1) call abort ()
+    else if (my_test_cnt == 2) then
+      if (this_% n /= 10 .or. this_% id /= 0) call abort ()
+    else
+      call abort ()
+    end if
+    my_test_cnt = my_test_cnt + 1
+  end subroutine Print_rational_t
+
+  subroutine Rational_t_init (this_)
+    class (rational_t), intent (in out) :: this_
+
+    this_% n = 10
+    this_% id = 0
+
+  end subroutine Rational_t_init
+
+end module Rational
+
+module Temp_node
+  use test_cnt
+  implicit none
+  private
+
+  real, parameter :: NOMINAL_TEMP = 20.0
+
+  type, public :: temp_node_t
+    real :: temperature = NOMINAL_TEMP
+    integer :: id = 1
+  contains
+    procedure :: Print_temp_node_t
+    procedure, private :: Temp_node_t_init
+    generic :: Print => Print_temp_node_t
+  end type temp_node_t
+
+  interface temp_node_t
+    module procedure Construct_temp_node_t
+  end interface
+
+contains
+
+  function Construct_temp_node_t (message_) result (return_type)
+    character (*), intent (in) :: message_
+    type (temp_node_t) :: return_type
+
+    !print *, trim (message_)
+    if (my_test_cnt /= 4) call abort()
+    my_test_cnt = my_test_cnt + 1
+    call return_type % Temp_node_t_init
+
+  end function Construct_temp_node_t
+
+  subroutine Print_temp_node_t (this_)
+    class (temp_node_t), intent (in) :: this_
+
+!    print *, "temp, id", this_% temperature, this_% id
+    if (my_test_cnt == 3) then
+      if (this_% temperature /= 20 .or. this_% id /= 1) call abort ()
+    else if (my_test_cnt == 5) then
+      if (this_% temperature /= 10 .or. this_% id /= 0) call abort ()
+    else
+      call abort ()
+    end if
+    my_test_cnt = my_test_cnt + 1
+  end subroutine Print_temp_node_t
+
+  subroutine Temp_node_t_init (this_)
+    class (temp_node_t), intent (in out) :: this_
+
+    this_% temperature = 10.0
+    this_% id = 0
+
+  end subroutine Temp_node_t_init
+
+end module Temp_node
+
+program Struct_over
+  use test_cnt
+  use Rational,  only : rational_t
+  use Temp_node, only : temp_node_t
+
+  implicit none
+
+  type (rational_t)  :: sample_rational_t
+  type (temp_node_t) :: sample_temp_node_t
+
+!  print *, "rational_t"
+!  print *, "----------"
+!  print *, ""
+!
+!  print *, "after declaration"
+  if (my_test_cnt /= 0) call abort()
+  call sample_rational_t % print
+
+  if (my_test_cnt /= 1) call abort()
+
+  sample_rational_t = sample_rational_t % rational_t ("using override")
+  if (my_test_cnt /= 2) call abort()
+!  print *, "after override"
+  !  call print (sample_rational_t)
+  !  call sample_rational_t % print ()
+  call sample_rational_t % print
+
+  if (my_test_cnt /= 3) call abort()
+
+!  print *, "sample_t"
+!  print *, "--------"
+!  print *, ""
+!
+!  print *, "after declaration"
+  call sample_temp_node_t % print
+
+  if (my_test_cnt /= 4) call abort()
+
+  sample_temp_node_t = temp_node_t ("using override")
+  if (my_test_cnt /= 5) call abort()
+!  print *, "after override"
+  !  call print (sample_rational_t)
+  !  call sample_rational_t % print ()
+  call sample_temp_node_t % print
+  if (my_test_cnt /= 6) call abort()
+
+end program Struct_over
+
+! { dg-final { cleanup-modules "test_cnt rational temp_node" } }
Index: gcc/testsuite/gfortran.dg/result_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/result_1.f90	(Revision 181028)
+++ gcc/testsuite/gfortran.dg/result_1.f90	(Arbeitskopie)
@@ -14,5 +14,10 @@  namelist /s/ a,b,c    ! { dg-error "attribute conf
 end function
 
 function h() result(t)
-type t    ! { dg-error "attribute conflicts" }
+type t    ! { dg-error "GENERIC attribute conflicts with RESULT attribute" }
+end type t ! { dg-error "Expecting END FUNCTION statement" }
 end function
+
+function i() result(t)
+type t    ! { dg-error "GENERIC attribute conflicts with RESULT attribute" }
+end function
Index: gcc/testsuite/gfortran.dg/structure_constructor_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/structure_constructor_4.f03	(Revision 181028)
+++ gcc/testsuite/gfortran.dg/structure_constructor_4.f03	(Arbeitskopie)
@@ -14,6 +14,6 @@  PROGRAM test
   TYPE(basics_t) :: basics
 
   basics = basics_t (42, r=1.5, i=15) ! { dg-error "'i' is initialized twice" }
-  basics = basics_t (42, r=1., r=-2.) ! { dg-error "'r' is initialized twice" }
+  basics = basics_t (42, r=1., r=-2.) ! { dg-error "has already appeared in the current argument list" }
 
 END PROGRAM test
Index: gcc/testsuite/gfortran.dg/type_decl_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/type_decl_3.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/type_decl_3.f90	(Revision 0)
@@ -0,0 +1,7 @@ 
+! { dg-do compile }
+!
+! PR fortran/39427
+!
+   subroutine t(x) ! { dg-error "conflicts with previously declared entity" }
+     type(t) :: x ! { dg-error "conflicts with previously declared entity" }
+   end subroutine t
Index: gcc/testsuite/gfortran.dg/used_types_26.f90
===================================================================
--- gcc/testsuite/gfortran.dg/used_types_26.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/used_types_26.f90	(Revision 0)
@@ -0,0 +1,22 @@ 
+! { dg-do compile }
+!
+! Check for ambiguity.
+!
+! Added as part of the constructor work (PR fortran/39427).
+!
+  module m
+    type t
+    end type t
+  end module m
+
+  module m2
+    type t
+    end type t
+  end module m2
+
+  use m
+  use m2
+  type(t) :: x ! { dg-error "Type name 't' at .1. is ambiguous" }
+  end
+
+! { dg-final { cleanup-modules "m m2" } }
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 181028)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -1262,8 +1262,9 @@  check_interface0 (gfc_interface *p, const char *in
     {
       /* Make sure all symbols in the interface have been defined as
 	 functions or subroutines.  */
-      if ((!p->sym->attr.function && !p->sym->attr.subroutine)
-	  || !p->sym->attr.if_source)
+      if (((!p->sym->attr.function && !p->sym->attr.subroutine)
+	   || !p->sym->attr.if_source)
+	  && p->sym->attr.flavor != FL_DERIVED)
 	{
 	  if (p->sym->attr.external)
 	    gfc_error ("Procedure '%s' in %s at %L has no explicit interface",
@@ -1276,11 +1277,18 @@  check_interface0 (gfc_interface *p, const char *in
 	}
 
       /* Verify that procedures are either all SUBROUTINEs or all FUNCTIONs.  */
-      if ((psave->sym->attr.function && !p->sym->attr.function)
+      if ((psave->sym->attr.function && !p->sym->attr.function
+	   && p->sym->attr.flavor != FL_DERIVED)
 	  || (psave->sym->attr.subroutine && !p->sym->attr.subroutine))
 	{
-	  gfc_error ("In %s at %L procedures must be either all SUBROUTINEs"
-		     " or all FUNCTIONs", interface_name, &p->sym->declared_at);
+	  if (p->sym->attr.flavor != FL_DERIVED)
+	    gfc_error ("In %s at %L procedures must be either all SUBROUTINEs"
+		       " or all FUNCTIONs", interface_name,
+		       &p->sym->declared_at);
+	  else
+	    gfc_error ("In %s at %L procedures must be all FUNCTIONs as the "
+		       "generic name is also the name of a derived type",
+		       interface_name, &p->sym->declared_at);
 	  return 1;
 	}
 
@@ -1336,8 +1344,10 @@  check_interface1 (gfc_interface *p, gfc_interface
 	if (p->sym->name == q->sym->name && p->sym->module == q->sym->module)
 	  continue;
 
-	if (gfc_compare_interfaces (p->sym, q->sym, q->sym->name, generic_flag,
-				    0, NULL, 0))
+	if (p->sym->attr.flavor != FL_DERIVED
+	    && q->sym->attr.flavor != FL_DERIVED
+	    && gfc_compare_interfaces (p->sym, q->sym, q->sym->name,
+				       generic_flag, 0, NULL, 0))
 	  {
 	    if (referenced)
 	      gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
@@ -3019,6 +3029,8 @@  gfc_search_interface (gfc_interface *intr, int sub
 
   for (; intr; intr = intr->next)
     {
+      if (intr->sym->attr.flavor == FL_DERIVED)
+	continue;
       if (sub_flag && intr->sym->attr.function)
 	continue;
       if (!sub_flag && intr->sym->attr.subroutine)
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(Revision 181028)
+++ gcc/fortran/trans-array.c	(Arbeitskopie)
@@ -5027,6 +5027,11 @@  gfc_conv_array_initializer (tree type, gfc_expr *
   tree index, range;
   VEC(constructor_elt,gc) *v = NULL;
 
+  if (expr->expr_type == EXPR_VARIABLE
+      && expr->symtree->n.sym->attr.flavor == FL_PARAMETER
+      && expr->symtree->n.sym->value)
+    expr = expr->symtree->n.sym->value;
+
   switch (expr->expr_type)
     {
     case EXPR_CONSTANT:
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 181028)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -1949,6 +1949,9 @@  gfc_use_derived (gfc_symbol *sym)
   if (!sym)
     return NULL;
 
+  if (sym->attr.generic)
+    sym = gfc_find_dt_in_generic (sym);
+
   if (sym->components != NULL || sym->attr.zero_comp)
     return sym;               /* Already defined.  */
 
@@ -2880,7 +2883,12 @@  gfc_undo_symbols (void)
 		}
 	    }
 
-	  gfc_delete_symtree (&p->ns->sym_root, p->name);
+	  if (p->attr.flavor == FL_DERIVED)
+	    gfc_delete_symtree (&p->ns->sym_root, gfc_get_string ("%c%s",
+                        (char) TOUPPER ((unsigned char) p->name[0]),
+                        &p->name[1]));
+	  else
+	    gfc_delete_symtree (&p->ns->sym_root, p->name);
 
 	  gfc_release_symbol (p);
 	  continue;
@@ -3310,46 +3318,81 @@  gfc_symbol_done_2 (void)
 }
 
 
-/* Clear mark bits from symbol nodes associated with a symtree node.  */
+/* Count how many nodes a symtree has.  */
 
-static void
-clear_sym_mark (gfc_symtree *st)
+static unsigned
+count_st_nodes (const gfc_symtree *st)
 {
+  unsigned nodes;
+  if (!st)
+    return 0;
 
-  st->n.sym->mark = 0;
+  nodes = count_st_nodes (st->left);
+  nodes++;
+  nodes += count_st_nodes (st->right);
+
+  return nodes;
 }
 
 
-/* Recursively traverse the symtree nodes.  */
+/* Convert symtree tree into symtree vector.  */
 
-void
-gfc_traverse_symtree (gfc_symtree *st, void (*func) (gfc_symtree *))
+static unsigned
+fill_st_vector (gfc_symtree *st, gfc_symtree **st_vec, unsigned node_cntr)
 {
   if (!st)
-    return;
+    return node_cntr;
 
-  gfc_traverse_symtree (st->left, func);
-  (*func) (st);
-  gfc_traverse_symtree (st->right, func);
+  node_cntr = fill_st_vector (st->left, st_vec, node_cntr);
+  st_vec[node_cntr++] = st;
+  node_cntr = fill_st_vector (st->right, st_vec, node_cntr);
+
+  return node_cntr;
 }
 
 
-/* Recursive namespace traversal function.  */
+/* Traverse namespace.  As the functions might modify the symtree, we store the
+   symtree as a vector and operate on this vector.  Note: We assume that
+   sym_func or st_func never deletes nodes from the symtree - only adding is
+   allowed.  */
 
 static void
-traverse_ns (gfc_symtree *st, void (*func) (gfc_symbol *))
+do_traverse_symtree (gfc_symtree *st, void (*st_func) (gfc_symtree *),
+		     void (*sym_func) (gfc_symbol *))
 {
+  gfc_symtree **st_vec;
+  unsigned nodes, i, node_cntr;
 
-  if (st == NULL)
-    return;
+  gcc_assert ((st_func && !sym_func) || (!st_func && sym_func));
+  nodes = count_st_nodes (st);
+  st_vec = XALLOCAVEC (gfc_symtree *, nodes);
+  node_cntr = 0; 
+  fill_st_vector (st, st_vec, node_cntr);
 
-  traverse_ns (st->left, func);
+  if (sym_func)
+    {
+      /* Clear marks.  */
+      for (i = 0; i < nodes; i++)
+	st_vec[i]->n.sym->mark = 0;
+      for (i = 0; i < nodes; i++)
+	if (!st_vec[i]->n.sym->mark)
+	  {
+	    (*sym_func) (st_vec[i]->n.sym);
+	    st_vec[i]->n.sym->mark = 1;
+	  }
+     }
+   else
+      for (i = 0; i < nodes; i++)
+	(*st_func) (st_vec[i]);
+}
 
-  if (st->n.sym->mark == 0)
-    (*func) (st->n.sym);
-  st->n.sym->mark = 1;
 
-  traverse_ns (st->right, func);
+/* Recursively traverse the symtree nodes.  */
+
+void
+gfc_traverse_symtree (gfc_symtree *st, void (*st_func) (gfc_symtree *))
+{
+  do_traverse_symtree (st, st_func, NULL);
 }
 
 
@@ -3357,12 +3400,9 @@  static void
    care that each gfc_symbol node is called exactly once.  */
 
 void
-gfc_traverse_ns (gfc_namespace *ns, void (*func) (gfc_symbol *))
+gfc_traverse_ns (gfc_namespace *ns, void (*sym_func) (gfc_symbol *))
 {
-
-  gfc_traverse_symtree (ns->sym_root, clear_sym_mark);
-
-  traverse_ns (ns->sym_root, func);
+  do_traverse_symtree (ns->sym_root, NULL, sym_func);
 }
 
 
@@ -3741,15 +3781,15 @@  gen_special_c_interop_ptr (int ptr_id, const char
          that has arg(s) of the missing type.  In this case, a
          regular version of the thing should have been put in the
          current ns.  */
+
       generate_isocbinding_symbol (module_name, ptr_id == ISOCBINDING_NULL_PTR 
                                    ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR,
                                    (const char *) (ptr_id == ISOCBINDING_NULL_PTR 
-				   ? "_gfortran_iso_c_binding_c_ptr"
-				   : "_gfortran_iso_c_binding_c_funptr"));
-
+				   ? "c_ptr"
+				   : "c_funptr"));
       tmp_sym->ts.u.derived =
-        get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
-                              ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
+	get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
+			      ? ISOCBINDING_PTR : ISOCBINDING_FUNPTR);
     }
 
   /* Module name is some mangled version of iso_c_binding.  */
@@ -3827,9 +3867,9 @@  gen_cptr_param (gfc_formal_arglist **head,
   const char *c_ptr_type = NULL;
 
   if (iso_c_sym_id == ISOCBINDING_F_PROCPOINTER)
-    c_ptr_type = "_gfortran_iso_c_binding_c_funptr";
+    c_ptr_type = "c_funptr";
   else
-    c_ptr_type = "_gfortran_iso_c_binding_c_ptr";
+    c_ptr_type = "c_ptr";
 
   if(c_ptr_name == NULL)
     c_ptr_in = "gfc_cptr__";
@@ -4306,20 +4346,32 @@  generate_isocbinding_symbol (const char *mod_name,
 					     : c_interop_kinds_table[s].name;
   gfc_symtree *tmp_symtree = NULL;
   gfc_symbol *tmp_sym = NULL;
-  gfc_dt_list **dt_list_ptr = NULL;
-  gfc_component *tmp_comp = NULL;
-  char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
   int index;
 
   if (gfc_notification_std (std_for_isocbinding_symbol (s)) == ERROR)
     return;
+
   tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
 
-  /* Already exists in this scope so don't re-add it.
-     TODO: we should probably check that it's really the same symbol.  */
-  if (tmp_symtree != NULL)
-    return;
+  /* Already exists in this scope so don't re-add it. */
+  if (tmp_symtree != NULL && (tmp_sym = tmp_symtree->n.sym) != NULL
+      && (!tmp_sym->attr.generic
+	  || (tmp_sym = gfc_find_dt_in_generic (tmp_sym)) != NULL)
+      && tmp_sym->from_intmod == INTMOD_ISO_C_BINDING)
+    {
+      if (tmp_sym->attr.flavor == FL_DERIVED
+	  && !get_iso_c_binding_dt (tmp_sym->intmod_sym_id))
+	{
+	  gfc_dt_list *dt_list;
+	  dt_list = gfc_get_dt_list ();
+	  dt_list->derived = tmp_sym;
+	  dt_list->next = gfc_derived_types;
+  	  gfc_derived_types = dt_list;
+        }
 
+      return;
+    }
+
   /* Create the sym tree in the current ns.  */
   gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
   if (tmp_symtree)
@@ -4411,64 +4463,112 @@  generate_isocbinding_symbol (const char *mod_name,
 
       case ISOCBINDING_PTR:
       case ISOCBINDING_FUNPTR:
+	{
+	  gfc_interface *intr, *head;
+	  gfc_symbol *dt_sym;
+	  const char *hidden_name;
+	  gfc_dt_list **dt_list_ptr = NULL;
+	  gfc_component *tmp_comp = NULL;
+	  char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
 
-	/* Initialize an integer constant expression node.  */
-	tmp_sym->attr.flavor = FL_DERIVED;
-	tmp_sym->ts.is_c_interop = 1;
-	tmp_sym->attr.is_c_interop = 1;
-	tmp_sym->attr.is_iso_c = 1;
-	tmp_sym->ts.is_iso_c = 1;
-	tmp_sym->ts.type = BT_DERIVED;
+	  hidden_name = gfc_get_string ("%c%s",
+			    (char) TOUPPER ((unsigned char) tmp_sym->name[0]),
+                            &tmp_sym->name[1]);
 
-	/* A derived type must have the bind attribute to be
-	   interoperable (J3/04-007, Section 15.2.3), even though
-	   the binding label is not used.  */
-	tmp_sym->attr.is_bind_c = 1;
+	  /* Generate real derived type.  */
+	  tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+					  hidden_name);
 
-	tmp_sym->attr.referenced = 1;
+	  if (tmp_symtree != NULL)
+	    gcc_unreachable ();
+	  gfc_get_sym_tree (hidden_name, gfc_current_ns, &tmp_symtree, false);
+	  if (tmp_symtree)
+	    dt_sym = tmp_symtree->n.sym;
+	  else
+	    gcc_unreachable ();
 
-	tmp_sym->ts.u.derived = tmp_sym;
+	  /* Generate an artificial generic function.  */
+	  dt_sym->name = gfc_get_string (tmp_sym->name);
+	  head = tmp_sym->generic;
+	  intr = gfc_get_interface ();
+	  intr->sym = dt_sym;
+	  intr->where = gfc_current_locus;
+	  intr->next = head;
+	  tmp_sym->generic = intr;
 
-        /* Add the symbol created for the derived type to the current ns.  */
-        dt_list_ptr = &(gfc_derived_types);
-        while (*dt_list_ptr != NULL && (*dt_list_ptr)->next != NULL)
-          dt_list_ptr = &((*dt_list_ptr)->next);
+	  if (!tmp_sym->attr.generic
+	      && gfc_add_generic (&tmp_sym->attr, tmp_sym->name, NULL)
+		 == FAILURE)
+	    return;
 
-        /* There is already at least one derived type in the list, so append
-           the one we're currently building for c_ptr or c_funptr.  */
-        if (*dt_list_ptr != NULL)
-          dt_list_ptr = &((*dt_list_ptr)->next);
-        (*dt_list_ptr) = gfc_get_dt_list ();
-        (*dt_list_ptr)->derived = tmp_sym;
-        (*dt_list_ptr)->next = NULL;
+	  if (!tmp_sym->attr.function
+	      && gfc_add_function (&tmp_sym->attr, tmp_sym->name, NULL)
+		 == FAILURE)
+	    return;
 
-        /* Set up the component of the derived type, which will be
-           an integer with kind equal to c_ptr_size.  Mangle the name of
-           the field for the c_address to prevent the curious user from
-           trying to access it from Fortran.  */
-        sprintf (comp_name, "__%s_%s", tmp_sym->name, "c_address");
-        gfc_add_component (tmp_sym, comp_name, &tmp_comp);
-        if (tmp_comp == NULL)
+	  /* Say what module this symbol belongs to.  */
+	  dt_sym->module = gfc_get_string (mod_name);
+	  dt_sym->from_intmod = INTMOD_ISO_C_BINDING;
+	  dt_sym->intmod_sym_id = s;
+
+	  /* Initialize an integer constant expression node.  */
+	  dt_sym->attr.flavor = FL_DERIVED;
+	  dt_sym->ts.is_c_interop = 1;
+	  dt_sym->attr.is_c_interop = 1;
+	  dt_sym->attr.is_iso_c = 1;
+	  dt_sym->ts.is_iso_c = 1;
+	  dt_sym->ts.type = BT_DERIVED;
+
+	  /* A derived type must have the bind attribute to be
+	     interoperable (J3/04-007, Section 15.2.3), even though
+	     the binding label is not used.  */
+	  dt_sym->attr.is_bind_c = 1;
+
+	  dt_sym->attr.referenced = 1;
+	  dt_sym->ts.u.derived = dt_sym;
+
+	  /* Add the symbol created for the derived type to the current ns.  */
+	  dt_list_ptr = &(gfc_derived_types);
+	  while (*dt_list_ptr != NULL && (*dt_list_ptr)->next != NULL)
+	    dt_list_ptr = &((*dt_list_ptr)->next);
+
+	  /* There is already at least one derived type in the list, so append
+	     the one we're currently building for c_ptr or c_funptr.  */
+	  if (*dt_list_ptr != NULL)
+	    dt_list_ptr = &((*dt_list_ptr)->next);
+	  (*dt_list_ptr) = gfc_get_dt_list ();
+	  (*dt_list_ptr)->derived = dt_sym;
+	  (*dt_list_ptr)->next = NULL;
+
+	  /* Set up the component of the derived type, which will be
+	     an integer with kind equal to c_ptr_size.  Mangle the name of
+	     the field for the c_address to prevent the curious user from
+	     trying to access it from Fortran.  */
+	  sprintf (comp_name, "__%s_%s", dt_sym->name, "c_address");
+	  gfc_add_component (dt_sym, comp_name, &tmp_comp);
+	  if (tmp_comp == NULL)
           gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
 			      "create component for c_address");
 
-        tmp_comp->ts.type = BT_INTEGER;
+	  tmp_comp->ts.type = BT_INTEGER;
 
-        /* Set this because the module will need to read/write this field.  */
-        tmp_comp->ts.f90_type = BT_INTEGER;
+	  /* Set this because the module will need to read/write this field.  */
+	  tmp_comp->ts.f90_type = BT_INTEGER;
 
-        /* The kinds for c_ptr and c_funptr are the same.  */
-        index = get_c_kind ("c_ptr", c_interop_kinds_table);
-        tmp_comp->ts.kind = c_interop_kinds_table[index].value;
+	  /* The kinds for c_ptr and c_funptr are the same.  */
+	  index = get_c_kind ("c_ptr", c_interop_kinds_table);
+	  tmp_comp->ts.kind = c_interop_kinds_table[index].value;
 
-        tmp_comp->attr.pointer = 0;
-        tmp_comp->attr.dimension = 0;
+	  tmp_comp->attr.pointer = 0;
+	  tmp_comp->attr.dimension = 0;
 
-        /* Mark the component as C interoperable.  */
-        tmp_comp->ts.is_c_interop = 1;
+	  /* Mark the component as C interoperable.  */
+	  tmp_comp->ts.is_c_interop = 1;
 
-        /* Make it use associated (iso_c_binding module).  */
-        tmp_sym->attr.use_assoc = 1;
+	  /* Make it use associated (iso_c_binding module).  */
+	  dt_sym->attr.use_assoc = 1;
+	}
+
 	break;
 
       case ISOCBINDING_NULL_PTR:
@@ -4518,21 +4618,20 @@  generate_isocbinding_symbol (const char *mod_name,
                   tmp_sym->ts.u.derived =
                     get_iso_c_binding_dt (ISOCBINDING_FUNPTR);
 
-                if (tmp_sym->ts.u.derived == NULL)
-                  {
+		if (tmp_sym->ts.u.derived == NULL)
+		  {
                     /* Create the necessary derived type so we can continue
                        processing the file.  */
-                    generate_isocbinding_symbol
+		    generate_isocbinding_symbol
 		      (mod_name, s == ISOCBINDING_FUNLOC
-				 ? ISOCBINDING_FUNPTR : ISOCBINDING_PTR,
-		       (const char *)(s == ISOCBINDING_FUNLOC
-                                ? "_gfortran_iso_c_binding_c_funptr"
-				: "_gfortran_iso_c_binding_c_ptr"));
+				? ISOCBINDING_FUNPTR : ISOCBINDING_PTR,
+		      (const char *)(s == ISOCBINDING_FUNLOC
+				? "c_funptr" : "c_ptr"));
                     tmp_sym->ts.u.derived =
-                      get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
-                                            ? ISOCBINDING_FUNPTR
-                                            : ISOCBINDING_PTR);
-                  }
+		    get_iso_c_binding_dt (s == ISOCBINDING_FUNLOC
+					    ? ISOCBINDING_FUNPTR
+					    : ISOCBINDING_PTR);
+		  }
 
 		/* The function result is itself (no result clause).  */
 		tmp_sym->result = tmp_sym;
@@ -4680,6 +4779,9 @@  gfc_get_typebound_proc (gfc_typebound_proc *tb0)
 gfc_symbol*
 gfc_get_derived_super_type (gfc_symbol* derived)
 {
+  if (derived && derived->attr.generic)
+    derived = gfc_find_dt_in_generic (derived);
+
   if (!derived->attr.extension)
     return NULL;
 
@@ -4687,6 +4789,9 @@  gfc_get_derived_super_type (gfc_symbol* derived)
   gcc_assert (derived->components->ts.type == BT_DERIVED);
   gcc_assert (derived->components->ts.u.derived);
 
+  if (derived->components->ts.u.derived->attr.generic)
+    return gfc_find_dt_in_generic (derived->components->ts.u.derived);
+
   return derived->components->ts.u.derived;
 }
 
@@ -4782,3 +4887,19 @@  gfc_is_associate_pointer (gfc_symbol* sym)
 
   return true;
 }
+
+
+gfc_symbol *
+gfc_find_dt_in_generic (gfc_symbol *sym)
+{
+  gfc_interface *intr = NULL;
+
+  if (!sym || sym->attr.flavor == FL_DERIVED)
+    return sym;
+
+  if (sym->attr.generic)
+    for (intr = (sym ? sym->generic : NULL); intr; intr = intr->next)
+      if (intr->sym->attr.flavor == FL_DERIVED)
+        break;
+  return intr ? intr->sym : NULL;
+}
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(Revision 181028)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -323,7 +323,7 @@  static match
 match_data_constant (gfc_expr **result)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
-  gfc_symbol *sym;
+  gfc_symbol *sym, *dt_sym = NULL;
   gfc_expr *expr;
   match m;
   locus old_loc;
@@ -366,15 +366,19 @@  match_data_constant (gfc_expr **result)
   if (gfc_find_symbol (name, NULL, 1, &sym))
     return MATCH_ERROR;
 
+  if (sym && sym->attr.generic)
+    dt_sym = gfc_find_dt_in_generic (sym);
+
   if (sym == NULL
-      || (sym->attr.flavor != FL_PARAMETER && sym->attr.flavor != FL_DERIVED))
+      || (sym->attr.flavor != FL_PARAMETER
+	  && (!dt_sym || dt_sym->attr.flavor != FL_DERIVED)))
     {
       gfc_error ("Symbol '%s' must be a PARAMETER in DATA statement at %C",
 		 name);
       return MATCH_ERROR;
     }
-  else if (sym->attr.flavor == FL_DERIVED)
-    return gfc_match_structure_constructor (sym, result, false);
+  else if (dt_sym && dt_sym->attr.flavor == FL_DERIVED)
+    return gfc_match_structure_constructor (dt_sym, result);
 
   /* Check to see if the value is an initialization array expression.  */
   if (sym->value->expr_type == EXPR_ARRAY)
@@ -1954,10 +1958,10 @@  variable_decl (int elem)
       st = gfc_find_symtree (gfc_current_ns->sym_root, current_ts.u.derived->name);
       if (!(current_ts.u.derived->attr.imported
 		&& st != NULL
-		&& st->n.sym == current_ts.u.derived)
+		&& gfc_find_dt_in_generic (st->n.sym) == current_ts.u.derived)
 	    && !gfc_current_ns->has_import_set)
 	{
-	    gfc_error ("the type of '%s' at %C has not been declared within the "
+	    gfc_error ("The type of '%s' at %C has not been declared within the "
 		       "interface", name);
 	    m = MATCH_ERROR;
 	    goto cleanup;
@@ -2501,10 +2505,11 @@  match
 gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
-  gfc_symbol *sym;
+  gfc_symbol *sym, *dt_sym;
   match m;
   char c;
   bool seen_deferred_kind, matched_type;
+  const char *dt_name;
 
   /* A belt and braces check that the typespec is correctly being treated
      as a deferred characteristic association.  */
@@ -2668,41 +2673,94 @@  gfc_match_decl_type_spec (gfc_typespec *ts, int im
       ts->u.derived = NULL;
       if (gfc_current_state () != COMP_INTERFACE
 	    && !gfc_find_symbol (name, NULL, 1, &sym) && sym)
-	ts->u.derived = sym;
+	{
+	  sym = gfc_find_dt_in_generic (sym);
+	  ts->u.derived = sym;
+	}
       return MATCH_YES;
     }
 
   /* Search for the name but allow the components to be defined later.  If
      type = -1, this typespec has been seen in a function declaration but
      the type could not be accessed at that point.  */
+  dt_name = gfc_get_string ("%c%s",
+			    (char) TOUPPER ((unsigned char) name[0]),
+			    (const char*)&name[1]);
   sym = NULL;
-  if (ts->kind != -1 && gfc_get_ha_symbol (name, &sym))
+  dt_sym = NULL;
+  if (ts->kind != -1)
     {
-      gfc_error ("Type name '%s' at %C is ambiguous", name);
-      return MATCH_ERROR;
+      gfc_get_ha_symbol (name, &sym);
+      if (sym->generic && gfc_find_symbol (dt_name, NULL, 0, &dt_sym))
+	{
+	  gfc_error ("Type name '%s' at %C is ambiguous", name);
+	  return MATCH_ERROR;
+	}
+      if (sym->generic && !dt_sym)
+	dt_sym = gfc_find_dt_in_generic (sym);
     }
   else if (ts->kind == -1)
     {
       int iface = gfc_state_stack->previous->state != COMP_INTERFACE
 		    || gfc_current_ns->has_import_set;
-      if (gfc_find_symbol (name, NULL, iface, &sym))
+      gfc_find_symbol (name, NULL, iface, &sym);
+      if (sym && sym->generic && gfc_find_symbol (dt_name, NULL, 1, &dt_sym))
 	{       
 	  gfc_error ("Type name '%s' at %C is ambiguous", name);
 	  return MATCH_ERROR;
 	}
+      if (sym && sym->generic && !dt_sym)
+	dt_sym = gfc_find_dt_in_generic (sym);
 
       ts->kind = 0;
       if (sym == NULL)
 	return MATCH_NO;
     }
 
-  if (sym->attr.flavor != FL_DERIVED
-      && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
-    return MATCH_ERROR;
+  if ((sym->attr.flavor != FL_UNKNOWN
+       && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.generic))
+      || sym->attr.subroutine)
+    {
+      gfc_error ("Type name '%s' at %C conflicts with previously declared "
+	         "entity at %L, which has the same name", name,
+		 &sym->declared_at);
+      return MATCH_ERROR;
+    }
 
   gfc_set_sym_referenced (sym);
-  ts->u.derived = sym;
+  if (!sym->attr.generic
+      && gfc_add_generic (&sym->attr, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
 
+  if (!sym->attr.function
+      && gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  if (!dt_sym)
+    {
+      gfc_interface *intr, *head;
+
+      /* Use upper case to save the actual derived-type symbol.  */
+      gfc_get_symbol (dt_name, NULL, &dt_sym);
+      dt_sym->name = gfc_get_string (sym->name);
+      head = sym->generic;
+      intr = gfc_get_interface ();
+      intr->sym = dt_sym;
+      intr->where = gfc_current_locus;
+      intr->next = head;
+      sym->generic = intr;
+      sym->attr.if_source = IFSRC_DECL;
+    }
+
+  gfc_set_sym_referenced (dt_sym);
+
+  if (dt_sym->attr.flavor != FL_DERIVED
+      && gfc_add_flavor (&dt_sym->attr, FL_DERIVED, sym->name, NULL)
+			 == FAILURE)
+    return MATCH_ERROR;
+
+  ts->u.derived = dt_sym;
+
   return MATCH_YES;
 
 get_kind:
@@ -3053,6 +3111,17 @@  gfc_match_import (void)
 	  sym->refs++;
 	  sym->attr.imported = 1;
 
+	  if (sym->attr.generic && (sym = gfc_find_dt_in_generic (sym)))
+	    {
+	      st = gfc_new_symtree (&gfc_current_ns->sym_root,
+			gfc_get_string ("%c%s",
+				(char) TOUPPER ((unsigned char) sym->name[0]),
+				&sym->name[1]));
+	      st->n.sym = sym;
+	      sym->refs++;
+	      sym->attr.imported = 1;
+	    }
+
 	  goto next_item;
 
 	case MATCH_NO:
@@ -6475,7 +6544,7 @@  access_attr_decl (gfc_statement st)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   interface_type type;
   gfc_user_op *uop;
-  gfc_symbol *sym;
+  gfc_symbol *sym, *dt_sym;
   gfc_intrinsic_op op;
   match m;
 
@@ -6505,6 +6574,13 @@  access_attr_decl (gfc_statement st)
 			      sym->name, NULL) == FAILURE)
 	    return MATCH_ERROR;
 
+	  if (sym->attr.generic && (dt_sym = gfc_find_dt_in_generic (sym))
+	      && gfc_add_access (&dt_sym->attr,
+				 (st == ST_PUBLIC) ? ACCESS_PUBLIC
+						   : ACCESS_PRIVATE,
+				 sym->name, NULL) == FAILURE)
+	    return MATCH_ERROR;
+
 	  break;
 
 	case INTERFACE_INTRINSIC_OP:
@@ -7175,6 +7251,8 @@  check_extended_derived_type (char *name)
       return NULL;
     }
 
+  extended = gfc_find_dt_in_generic (extended);
+
   if (extended->attr.flavor != FL_DERIVED)
     {
       gfc_error ("'%s' in EXTENDS expression at %C is not a "
@@ -7277,11 +7355,12 @@  gfc_match_derived_decl (void)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   char parent[GFC_MAX_SYMBOL_LEN + 1];
   symbol_attribute attr;
-  gfc_symbol *sym;
+  gfc_symbol *sym, *gensym;
   gfc_symbol *extended;
   match m;
   match is_type_attr_spec = MATCH_NO;
   bool seen_attr = false;
+  gfc_interface *intr = NULL, *head;
 
   if (gfc_current_state () == COMP_DERIVED)
     return MATCH_NO;
@@ -7327,16 +7406,50 @@  gfc_match_derived_decl (void)
       return MATCH_ERROR;
     }
 
-  if (gfc_get_symbol (name, NULL, &sym))
+  if (gfc_get_symbol (name, NULL, &gensym))
     return MATCH_ERROR;
 
-  if (sym->ts.type != BT_UNKNOWN)
+  if (!gensym->attr.generic && gensym->ts.type != BT_UNKNOWN)
     {
       gfc_error ("Derived type name '%s' at %C already has a basic type "
-		 "of %s", sym->name, gfc_typename (&sym->ts));
+		 "of %s", gensym->name, gfc_typename (&gensym->ts));
       return MATCH_ERROR;
     }
 
+  if (!gensym->attr.generic
+      && gfc_add_generic (&gensym->attr, gensym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  if (!gensym->attr.function
+      && gfc_add_function (&gensym->attr, gensym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  sym = gfc_find_dt_in_generic (gensym);
+
+  if (sym && (sym->components != NULL || sym->attr.zero_comp))
+    {
+      gfc_error ("Derived type definition of '%s' at %C has already been "
+                 "defined", sym->name);
+      return MATCH_ERROR;
+    }
+
+  if (!sym)
+    {
+      /* Use upper case to save the actual derived-type symbol.  */
+      gfc_get_symbol (gfc_get_string ("%c%s",
+			(char) TOUPPER ((unsigned char) gensym->name[0]),
+			&gensym->name[1]), NULL, &sym);
+      sym->name = gfc_get_string (gensym->name);
+      head = gensym->generic;
+      intr = gfc_get_interface ();
+      intr->sym = sym;
+      intr->where = gfc_current_locus;
+      intr->sym->declared_at = gfc_current_locus;
+      intr->next = head;
+      gensym->generic = intr;
+      gensym->attr.if_source = IFSRC_DECL;
+    }
+
   /* The symbol may already have the derived attribute without the
      components.  The ways this can happen is via a function
      definition, an INTRINSIC statement or a subtype in another
@@ -7346,17 +7459,19 @@  gfc_match_derived_decl (void)
       && gfc_add_flavor (&sym->attr, FL_DERIVED, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
 
-  if (sym->components != NULL || sym->attr.zero_comp)
-    {
-      gfc_error ("Derived type definition of '%s' at %C has already been "
-		 "defined", sym->name);
-      return MATCH_ERROR;
-    }
-
   if (attr.access != ACCESS_UNKNOWN
       && gfc_add_access (&sym->attr, attr.access, sym->name, NULL) == FAILURE)
     return MATCH_ERROR;
+  else if (sym->attr.access == ACCESS_UNKNOWN
+	   && gensym->attr.access != ACCESS_UNKNOWN
+	   && gfc_add_access (&sym->attr, gensym->attr.access, sym->name, NULL)
+	      == FAILURE)
+    return MATCH_ERROR;
 
+  if (sym->attr.access != ACCESS_UNKNOWN
+      && gensym->attr.access == ACCESS_UNKNOWN)
+    gensym->attr.access = sym->attr.access;
+
   /* See if the derived type was labeled as bind(c).  */
   if (attr.is_bind_c != 0)
     sym->attr.is_bind_c = attr.is_bind_c;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(Revision 181028)
+++ gcc/fortran/gfortran.h	(Arbeitskopie)
@@ -2630,6 +2630,7 @@  gfc_try gfc_check_symbol_typed (gfc_symbol*, gfc_n
 gfc_namespace* gfc_find_proc_namespace (gfc_namespace*);
 
 bool gfc_is_associate_pointer (gfc_symbol*);
+gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
 
 /* intrinsic.c -- true if working in an init-expr, false otherwise.  */
 extern bool gfc_init_expr_flag;
@@ -2874,6 +2875,9 @@  match gfc_match_rvalue (gfc_expr **);
 match gfc_match_varspec (gfc_expr*, int, bool, bool);
 int gfc_check_digit (char, int);
 bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
+gfc_try gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *,
+					      gfc_expr **,
+					      gfc_actual_arglist **, bool);
 
 /* trans.c */
 void gfc_generate_code (gfc_namespace *);
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(Revision 181028)
+++ gcc/fortran/module.c	(Arbeitskopie)
@@ -80,7 +80,7 @@  along with GCC; see the file COPYING3.  If not see
 
 /* Don't put any single quote (') in MOD_VERSION, 
    if yout want it to be recognized.  */
-#define MOD_VERSION "7"
+#define MOD_VERSION "8"
 
 
 /* Structure that describes a position within a module file.  */
@@ -429,6 +429,24 @@  resolve_fixups (fixup_t *f, void *gp)
 }
 
 
+const char *
+dt_lower_string (const char *name)
+{
+  if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
+    return gfc_get_string ("%c%s", (char) TOLOWER ((unsigned char) name[0]),
+			   &name[1]);
+  return gfc_get_string (name);
+}
+
+const char *
+dt_upper_string (const char *name)
+{
+  if (name[0] != (char) TOUPPER ((unsigned char) name[0]))
+    return gfc_get_string ("%c%s", (char) TOUPPER ((unsigned char) name[0]),
+			   &name[1]);
+  return gfc_get_string (name);
+}
+
 /* Call here during module reading when we know what pointer to
    associate with an integer.  Any fixups that exist are resolved at
    this time.  */
@@ -699,12 +717,18 @@  static const char *
 find_use_name_n (const char *name, int *inst, bool interface)
 {
   gfc_use_rename *u;
+  const char *low_name = NULL;
   int i;
 
+  /* For derived types.  */
+  if (name[0] != (char) TOLOWER ((unsigned char) name[0]))
+    low_name = dt_lower_string (name);
+
   i = 0;
   for (u = gfc_rename_list; u; u = u->next)
     {
-      if (strcmp (u->use_name, name) != 0
+      if ((!low_name && strcmp (u->use_name, name) != 0)
+	  || (low_name && strcmp (u->use_name, low_name) != 0)
 	  || (u->op == INTRINSIC_USER && !interface)
 	  || (u->op != INTRINSIC_USER &&  interface))
 	continue;
@@ -723,6 +747,13 @@  find_use_name_n (const char *name, int *inst, bool
 
   u->found = 1;
 
+  if (low_name)
+    {
+      if (u->local_name[0] == '\0')
+	return name;
+      return dt_upper_string (u->local_name);
+    }
+
   return (u->local_name[0] != '\0') ? u->local_name : name;
 }
 
@@ -780,6 +811,7 @@  find_use_operator (gfc_intrinsic_op op)
 typedef struct true_name
 {
   BBT_HEADER (true_name);
+  const char *name;
   gfc_symbol *sym;
 }
 true_name;
@@ -803,7 +835,7 @@  compare_true_names (void *_t1, void *_t2)
   if (c != 0)
     return c;
 
-  return strcmp (t1->sym->name, t2->sym->name);
+  return strcmp (t1->name, t2->name);
 }
 
 
@@ -817,7 +849,7 @@  find_true_name (const char *name, const char *modu
   gfc_symbol sym;
   int c;
 
-  sym.name = gfc_get_string (name);
+  t.name = gfc_get_string (name);
   if (module != NULL)
     sym.module = gfc_get_string (module);
   else
@@ -847,6 +879,10 @@  add_true_name (gfc_symbol *sym)
 
   t = XCNEW (true_name);
   t->sym = sym;
+  if (sym->attr.flavor == FL_DERIVED)
+    t->name = dt_upper_string (sym->name);
+  else
+    t->name = sym->name;
 
   gfc_insert_bbt (&true_name_root, t, compare_true_names);
 }
@@ -858,13 +894,19 @@  add_true_name (gfc_symbol *sym)
 static void
 build_tnt (gfc_symtree *st)
 {
+  const char *name;
   if (st == NULL)
     return;
 
   build_tnt (st->left);
   build_tnt (st->right);
 
-  if (find_true_name (st->n.sym->name, st->n.sym->module) != NULL)
+  if (st->n.sym->attr.flavor == FL_DERIVED)
+    name = dt_upper_string (st->n.sym->name);
+  else
+    name = st->n.sym->name;
+
+  if (find_true_name (name, st->n.sym->module) != NULL)
     return;
 
   add_true_name (st->n.sym);
@@ -2986,8 +3028,12 @@  fix_mio_expr (gfc_expr *e)
 	 namespace to see if the required, non-contained symbol is available
 	 yet. If so, the latter should be written.  */
       if (e->symtree->n.sym && check_unique_name (e->symtree->name))
-	ns_st = gfc_find_symtree (gfc_current_ns->sym_root,
-				  e->symtree->n.sym->name);
+	{
+          const char *name = e->symtree->n.sym->name;
+	  if (e->symtree->n.sym->attr.flavor == FL_DERIVED)
+	    name = dt_upper_string (name);
+	  ns_st = gfc_find_symtree (gfc_current_ns->sym_root, name);
+	}
 
       /* On the other hand, if the existing symbol is the module name or the
 	 new symbol is a dummy argument, do not do the promotion.  */
@@ -4205,6 +4251,7 @@  load_needed (pointer_info *p)
 				 1, &ns->proc_name);
 
       sym = gfc_new_symbol (p->u.rsym.true_name, ns);
+      sym->name = dt_lower_string (p->u.rsym.true_name);
       sym->module = gfc_get_string (p->u.rsym.module);
       strcpy (sym->binding_label, p->u.rsym.binding_label);
 
@@ -4497,6 +4544,7 @@  read_module (void)
 		{
 		  info->u.rsym.sym = gfc_new_symbol (info->u.rsym.true_name,
 						     gfc_current_ns);
+		  info->u.rsym.sym->name = dt_lower_string (info->u.rsym.true_name);
 		  sym = info->u.rsym.sym;
 		  sym->module = gfc_get_string (info->u.rsym.module);
 
@@ -4835,7 +4883,7 @@  write_dt_extensions (gfc_symtree *st)
     return;
 
   mio_lparen ();
-  mio_pool_string (&st->n.sym->name);
+  mio_pool_string (&st->name);
   if (st->n.sym->module != NULL)
     mio_pool_string (&st->n.sym->module);
   else
@@ -4870,8 +4918,16 @@  write_symbol (int n, gfc_symbol *sym)
     gfc_internal_error ("write_symbol(): bad module symbol '%s'", sym->name);
 
   mio_integer (&n);
-  mio_pool_string (&sym->name);
 
+  if (sym->attr.flavor == FL_DERIVED)
+    {
+      const char *name;
+      name = dt_upper_string (sym->name);
+      mio_pool_string (&name);
+    }
+  else
+    mio_pool_string (&sym->name);
+
   mio_pool_string (&sym->module);
   if (sym->attr.is_bind_c || sym->attr.is_iso_c)
     {
@@ -5566,7 +5622,8 @@  create_derived_type (const char *name, const char
 		      intmod_id module, int id)
 {
   gfc_symtree *tmp_symtree;
-  gfc_symbol *sym;
+  gfc_symbol *sym, *dt_sym;
+  gfc_interface *intr, *head;
 
   tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
   if (tmp_symtree != NULL)
@@ -5579,18 +5636,35 @@  create_derived_type (const char *name, const char
 
   gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree, false);
   sym = tmp_symtree->n.sym;
-
   sym->module = gfc_get_string (modname);
   sym->from_intmod = module;
   sym->intmod_sym_id = id;
-  sym->attr.flavor = FL_DERIVED;
-  sym->attr.private_comp = 1;
-  sym->attr.zero_comp = 1;
-  sym->attr.use_assoc = 1;
+  sym->attr.flavor = FL_PROCEDURE;
+  sym->attr.function = 1;
+  sym->attr.generic = 1;
+
+  gfc_get_sym_tree (dt_upper_string (sym->name),
+		    gfc_current_ns, &tmp_symtree, false);
+  dt_sym = tmp_symtree->n.sym;
+  dt_sym->name = gfc_get_string (sym->name);
+  dt_sym->attr.flavor = FL_DERIVED;
+  dt_sym->attr.private_comp = 1;
+  dt_sym->attr.zero_comp = 1;
+  dt_sym->attr.use_assoc = 1;
+  dt_sym->module = gfc_get_string (modname);
+  dt_sym->from_intmod = module;
+  dt_sym->intmod_sym_id = id;
+
+  head = sym->generic;
+  intr = gfc_get_interface ();
+  intr->sym = dt_sym;
+  intr->where = gfc_current_locus;
+  intr->next = head;
+  sym->generic = intr;
+  sym->attr.if_source = IFSRC_DECL;
 }
 
 
-
 /* USE the ISO_FORTRAN_ENV intrinsic module.  */
 
 static void
Index: gcc/fortran/trans-types.c
===================================================================
--- gcc/fortran/trans-types.c	(Revision 181028)
+++ gcc/fortran/trans-types.c	(Arbeitskopie)
@@ -2257,6 +2257,10 @@  gfc_get_derived_type (gfc_symbol * derived)
   gfc_dt_list *dt;
   gfc_namespace *ns;
 
+  if (derived && derived->attr.flavor == FL_PROCEDURE
+      && derived->attr.generic)
+    derived = gfc_find_dt_in_generic (derived);
+
   gcc_assert (derived && derived->attr.flavor == FL_DERIVED);
 
   /* See if it's one of the iso_c_binding derived types.  */
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 181028)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -454,7 +454,8 @@  resolve_formal_arglist (gfc_symbol *proc)
 static void
 find_arglists (gfc_symbol *sym)
 {
-  if (sym->attr.if_source == IFSRC_UNKNOWN || sym->ns != gfc_current_ns)
+  if (sym->attr.if_source == IFSRC_UNKNOWN || sym->ns != gfc_current_ns
+      || sym->attr.flavor == FL_DERIVED)
     return;
 
   resolve_formal_arglist (sym);
@@ -967,13 +968,6 @@  resolve_structure_cons (gfc_expr *expr, int init)
     resolve_fl_derived0 (expr->ts.u.derived);
 
   cons = gfc_constructor_first (expr->value.constructor);
-  /* A constructor may have references if it is the result of substituting a
-     parameter variable.  In this case we just pull out the component we
-     want.  */
-  if (expr->ref)
-    comp = expr->ref->u.c.sym->components;
-  else
-    comp = expr->ts.u.derived->components;
 
   /* See if the user is trying to invoke a structure constructor for one of
      the iso_c_binding derived types.  */
@@ -992,6 +986,14 @@  resolve_structure_cons (gfc_expr *expr, int init)
       && cons->expr && cons->expr->expr_type == EXPR_NULL)
     return SUCCESS;
 
+  /* A constructor may have references if it is the result of substituting a
+     parameter variable.  In this case we just pull out the component we
+     want.  */
+  if (expr->ref)
+    comp = expr->ref->u.c.sym->components;
+  else
+    comp = expr->ts.u.derived->components;
+
   for (; comp && cons; comp = comp->next, cons = gfc_constructor_next (cons))
     {
       int rank;
@@ -1401,7 +1403,8 @@  is_illegal_recursion (gfc_symbol* sym, gfc_namespa
   gfc_symbol* context_proc;
   gfc_namespace* real_context;
 
-  if (sym->attr.flavor == FL_PROGRAM)
+  if (sym->attr.flavor == FL_PROGRAM
+      || sym->attr.flavor == FL_DERIVED)
     return false;
 
   gcc_assert (sym->attr.flavor == FL_PROCEDURE);
@@ -2323,6 +2326,7 @@  resolve_generic_f (gfc_expr *expr)
 {
   gfc_symbol *sym;
   match m;
+  gfc_interface *intr = NULL;
 
   sym = expr->symtree->n.sym;
 
@@ -2335,6 +2339,11 @@  resolve_generic_f (gfc_expr *expr)
 	return FAILURE;
 
 generic:
+      if (!intr)
+	for (intr = sym->generic; intr; intr = intr->next)
+	  if (intr->sym->attr.flavor == FL_DERIVED)
+	    break;
+
       if (sym->ns->parent == NULL)
 	break;
       gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
@@ -2347,16 +2356,25 @@  generic:
 
   /* Last ditch attempt.  See if the reference is to an intrinsic
      that possesses a matching interface.  14.1.2.4  */
-  if (sym && !gfc_is_intrinsic (sym, 0, expr->where))
+  if (sym  && !intr && !gfc_is_intrinsic (sym, 0, expr->where))
     {
-      gfc_error ("There is no specific function for the generic '%s' at %L",
-		 expr->symtree->n.sym->name, &expr->where);
+      gfc_error ("There is no specific function for the generic '%s' "
+		 "at %L", expr->symtree->n.sym->name, &expr->where);
       return FAILURE;
     }
 
+  if (intr)
+    {
+      if (gfc_convert_to_structure_constructor (expr, intr->sym, NULL, NULL,
+						false) != SUCCESS)
+	return FAILURE;
+      return resolve_structure_cons (expr, 0);
+    }
+
   m = gfc_intrinsic_func_interface (expr, 0);
   if (m == MATCH_YES)
     return SUCCESS;
+
   if (m == MATCH_NO)
     gfc_error ("Generic function '%s' at %L is not consistent with a "
 	       "specific intrinsic interface", expr->symtree->n.sym->name,
@@ -5054,6 +5072,9 @@  resolve_variable (gfc_expr *e)
   if (sym->assoc && !sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
     return FAILURE;
 
+  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.generic)
+    sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
+
   /* On the other hand, the parser may not have known this is an array;
      in this case, we have to add a FULL reference.  */
   if (sym->assoc && sym->attr.dimension && !e->ref)
@@ -10141,6 +10162,8 @@  resolve_fl_variable_derived (gfc_symbol *sym, int
     {
       gfc_symbol *s;
       gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
+      if (s && s->attr.generic)
+	s = gfc_find_dt_in_generic (s);
       if (s && s->attr.flavor != FL_DERIVED)
 	{
 	  gfc_error ("The type '%s' cannot be host associated at %L "
@@ -11707,6 +11730,13 @@  resolve_fl_derived0 (gfc_symbol *sym)
 	    }
 	}
 
+      if (c->ts.type == BT_DERIVED && c->ts.u.derived->attr.generic)
+	c->ts.u.derived = gfc_find_dt_in_generic (c->ts.u.derived);
+      else if (c->ts.type == BT_CLASS && c->attr.class_ok
+	       && CLASS_DATA (c)->ts.u.derived->attr.generic)
+	CLASS_DATA (c)->ts.u.derived
+			= gfc_find_dt_in_generic (CLASS_DATA (c)->ts.u.derived);
+
       if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
 	  && c->attr.pointer && c->ts.u.derived->components == NULL
 	  && !c->ts.u.derived->attr.zero_comp)
@@ -11777,6 +11807,23 @@  resolve_fl_derived0 (gfc_symbol *sym)
 static gfc_try
 resolve_fl_derived (gfc_symbol *sym)
 {
+  gfc_symbol *gen_dt = NULL;
+
+  if (!sym->attr.is_class)
+    gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt);
+  if (gen_dt && gen_dt->generic && gen_dt->generic->next
+      && gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Generic name '%s' of "
+			 "function '%s' at %L being the same name as derived "
+			 "type at %L", sym->name,
+			 gen_dt->generic->sym == sym
+			   ? gen_dt->generic->next->sym->name
+			   : gen_dt->generic->sym->name,
+			 gen_dt->generic->sym == sym
+			   ? &gen_dt->generic->next->sym->declared_at
+			   : &gen_dt->generic->sym->declared_at,
+			 &sym->declared_at) == FAILURE)
+    return FAILURE;
+
   if (sym->attr.is_class && sym->ts.u.derived == NULL)
     {
       /* Fix up incomplete CLASS symbols.  */
@@ -12180,6 +12227,20 @@  resolve_symbol (gfc_symbol *sym)
 	}
     }
 
+  if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
+      && sym->ts.u.derived->attr.generic)
+    {
+      sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
+      if (!sym->ts.u.derived)
+	{
+	  gfc_error ("The derived type '%s' at %L is of type '%s', "
+		     "which has not been defined", sym->name,
+		     &sym->declared_at, sym->ts.u.derived->name);
+	  sym->ts.type = BT_UNKNOWN;
+	  return;
+	}
+    }
+
   /* If the symbol is marked as bind(c), verify it's type and kind.  Do not
      do this for something that was implicitly typed because that is handled
      in gfc_set_default_type.  Handle dummy arguments and procedure
@@ -12249,7 +12310,8 @@  resolve_symbol (gfc_symbol *sym)
      the type is not declared in the scope of the implicit
      statement. Change the type to BT_UNKNOWN, both because it is so
      and to prevent an ICE.  */
-  if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->components == NULL
+  if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
+      && sym->ts.u.derived->components == NULL
       && !sym->ts.u.derived->attr.zero_comp)
     {
       gfc_error ("The derived type '%s' at %L is of type '%s', "
@@ -12265,23 +12327,10 @@  resolve_symbol (gfc_symbol *sym)
   if (sym->ts.type == BT_DERIVED
 	&& sym->ts.u.derived->attr.use_assoc
 	&& sym->ns->proc_name
-	&& sym->ns->proc_name->attr.flavor == FL_MODULE)
-    {
-      gfc_symbol *ds;
+	&& sym->ns->proc_name->attr.flavor == FL_MODULE
+        && resolve_fl_derived (sym->ts.u.derived) == FAILURE)
+    return;
 
-      if (resolve_fl_derived (sym->ts.u.derived) == FAILURE)
-	return;
-
-      gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 1, &ds);
-      if (!ds && sym->attr.function && gfc_check_symbol_access (sym))
-	{
-	  symtree = gfc_new_symtree (&sym->ns->sym_root,
-				     sym->ts.u.derived->name);
-	  symtree->n.sym = sym->ts.u.derived;
-	  sym->ts.u.derived->refs++;
-	}
-    }
-
   /* Unless the derived-type declaration is use associated, Fortran 95
      does not allow public entries of private derived types.
      See 4.4.1 (F95) and 4.5.1.1 (F2003); and related interpretation
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(Revision 181028)
+++ gcc/fortran/match.c	(Arbeitskopie)
@@ -1920,6 +1920,9 @@  match_derived_type_spec (gfc_typespec *ts)
 
   gfc_find_symbol (name, NULL, 1, &derived);
 
+  if (derived && derived->attr.flavor == FL_PROCEDURE && derived->attr.generic)
+    derived = gfc_find_dt_in_generic (derived);
+
   if (derived && derived->attr.flavor == FL_DERIVED)
     {
       ts->type = BT_DERIVED;
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 181028)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -699,6 +699,18 @@  gfc_get_module_backend_decl (gfc_symbol *sym)
 	}
       else if (sym->attr.flavor == FL_DERIVED)
 	{
+	  if (s && s->attr.flavor == FL_PROCEDURE)
+	    {
+	      gfc_interface *intr;
+	      gcc_assert (s->attr.generic);
+	      for (intr = s->generic; intr; intr = intr->next)
+		if (intr->sym->attr.flavor == FL_DERIVED)
+		  {
+		    s = intr->sym;
+		    break;
+		  }
+    	    }
+
 	  if (!s->backend_decl)
 	    s->backend_decl = gfc_get_derived_type (s);
 	  gfc_copy_dt_decls_ifequal (s, sym, true);
@@ -4035,8 +4047,19 @@  gfc_trans_use_stmts (gfc_namespace * ns)
 	      st = gfc_find_symtree (ns->sym_root,
 				     rent->local_name[0]
 				     ? rent->local_name : rent->use_name);
-	      gcc_assert (st);
 
+	      /* The following can happen if a derived type is renamed.  */
+	      if (!st)
+		{
+		  char *name;
+		  name = xstrdup (rent->local_name[0]
+				  ? rent->local_name : rent->use_name);
+		  name[0] = (char) TOUPPER ((unsigned char) name[0]);
+		  st = gfc_find_symtree (ns->sym_root, name);
+		  free (name);
+		  gcc_assert (st);
+		}
+
 	      /* Sometimes, generic interfaces wind up being over-ruled by a
 		 local symbol (see PR41062).  */
 	      if (!st->n.sym->attr.use_assoc)
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(Revision 181028)
+++ gcc/fortran/match.h	(Arbeitskopie)
@@ -206,7 +206,7 @@  match gfc_match_bind_c (gfc_symbol *, bool);
 match gfc_get_type_attr_spec (symbol_attribute *, char*);
 
 /* primary.c.  */
-match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **, bool);
+match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);
 match gfc_match_variable (gfc_expr **, int);
 match gfc_match_equiv_variable (gfc_expr **);
 match gfc_match_actual_arglist (int, gfc_actual_arglist **);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(Revision 181028)
+++ gcc/fortran/parse.c	(Arbeitskopie)
@@ -3881,6 +3881,12 @@  gfc_fixup_sibling_symbols (gfc_symbol *sym, gfc_na
       if (!st || (st->n.sym->attr.dummy && ns == st->n.sym->ns))
 	goto fixup_contained;
 
+      if ((st->n.sym->attr.flavor == FL_DERIVED
+	   && sym->attr.generic && sym->attr.function)
+	  ||(sym->attr.flavor == FL_DERIVED
+	     && st->n.sym->attr.generic && st->n.sym->attr.function))
+	goto fixup_contained;
+
       old_sym = st->n.sym;
       if (old_sym->ns == ns
 	    && !old_sym->attr.contained
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(Revision 181028)
+++ gcc/fortran/primary.c	(Arbeitskopie)
@@ -2315,171 +2315,162 @@  build_actual_constructor (gfc_structure_ctor_compo
   return SUCCESS;
 }
 
-match
-gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result,
-				 bool parent)
+
+gfc_try
+gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **cexpr,
+				      gfc_actual_arglist **arglist,
+				      bool parent)
 {
+  gfc_actual_arglist *actual;
   gfc_structure_ctor_component *comp_tail, *comp_head, *comp_iter;
   gfc_constructor_base ctor_head = NULL;
   gfc_component *comp; /* Is set NULL when named component is first seen */
-  gfc_expr *e;
-  locus where;
-  match m;
   const char* last_name = NULL;
+  locus old_locus;
+  gfc_expr *expr;
 
+  expr = parent ? *cexpr : e;
+  old_locus = gfc_current_locus;
+  if (parent)
+    ; /* gfc_current_locus = *arglist->expr ? ->where;*/
+  else
+    gfc_current_locus = expr->where;
+
   comp_tail = comp_head = NULL;
 
-  if (!parent && gfc_match_char ('(') != MATCH_YES)
-    goto syntax;
-
-  where = gfc_current_locus;
-
-  gfc_find_component (sym, NULL, false, true);
-
-  /* Check that we're not about to construct an ABSTRACT type.  */
   if (!parent && sym->attr.abstract)
     {
-      gfc_error ("Can't construct ABSTRACT type '%s' at %C", sym->name);
-      return MATCH_ERROR;
+      gfc_error ("Can't construct ABSTRACT type '%s' at %L",
+		 sym->name, &expr->where);
+      goto cleanup;
     }
 
-  /* Match the component list and store it in a list together with the
-     corresponding component names.  Check for empty argument list first.  */
-  if (gfc_match_char (')') != MATCH_YES)
+  comp = sym->components;
+  actual = parent ? *arglist : expr->value.function.actual;
+  for ( ; actual; )
     {
-      comp = sym->components;
-      do
+      gfc_component *this_comp = NULL;
+
+      if (!comp_head)
+	comp_tail = comp_head = gfc_get_structure_ctor_component ();
+      else
 	{
-	  gfc_component *this_comp = NULL;
+	  comp_tail->next = gfc_get_structure_ctor_component ();
+	  comp_tail = comp_tail->next;
+       	}
+      if (actual->name)
+	{
+	  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+			      " constructor with named arguments at %C")
+	      == FAILURE)
+	    goto cleanup;
 
-	  if (comp == sym->components && sym->attr.extension
-	      && comp->ts.type == BT_DERIVED
-	      && comp->ts.u.derived->attr.zero_comp)
-	    /* Skip empty parents.  */ 
-	    comp = comp->next;
-
-	  if (!comp_head)
-	    comp_tail = comp_head = gfc_get_structure_ctor_component ();
-	  else
+	  comp_tail->name = xstrdup (actual->name); /*CONST_CAST (char *, actual->name);*/
+	  last_name = comp_tail->name;
+	  comp = NULL;
+	}
+      else
+	{
+	  /* Components without name are not allowed after the first named
+	     component initializer!  */
+	  if (!comp)
 	    {
-	      comp_tail->next = gfc_get_structure_ctor_component ();
-	      comp_tail = comp_tail->next;
+	      if (last_name)
+		gfc_error ("Component initializer without name after component"
+			   " named %s at %L!", last_name,
+			   actual->expr ? &actual->expr->where
+					: &gfc_current_locus);
+	      else
+		gfc_error ("Too many components in structure constructor at "
+			   "%L!", actual->expr ? &actual->expr->where
+					       : &gfc_current_locus);
+	      goto cleanup;
 	    }
-	  comp_tail->name = XCNEWVEC (char, GFC_MAX_SYMBOL_LEN + 1);
-	  comp_tail->val = NULL;
-	  comp_tail->where = gfc_current_locus;
 
-	  /* Try matching a component name.  */
-	  if (gfc_match_name (comp_tail->name) == MATCH_YES 
-	      && gfc_match_char ('=') == MATCH_YES)
-	    {
-	      if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
-				  " constructor with named arguments at %C")
-		  == FAILURE)
-		goto cleanup;
+	  comp_tail->name = xstrdup (comp->name); /*CONST_CAST (char *, comp->name);*/
+	}
 
-	      last_name = comp_tail->name;
-	      comp = NULL;
-	    }
-	  else
-	    {
-	      /* Components without name are not allowed after the first named
-		 component initializer!  */
-	      if (!comp)
-		{
-		  if (last_name)
-		    gfc_error ("Component initializer without name after"
-			       " component named %s at %C!", last_name);
-		  else if (!parent)
-		    gfc_error ("Too many components in structure constructor at"
-			       " %C!");
-		  goto cleanup;
-		}
+      /* Find the current component in the structure definition and check
+	     its access is not private.  */
+      if (comp)
+	this_comp = gfc_find_component (sym, comp->name, false, false);
+      else
+	{
+	  this_comp = gfc_find_component (sym, (const char *)comp_tail->name,
+					  false, false);
+	  comp = NULL; /* Reset needed!  */
+	}
 
-	      gfc_current_locus = comp_tail->where;
-	      strncpy (comp_tail->name, comp->name, GFC_MAX_SYMBOL_LEN + 1);
-	    }
+      /* Here we can check if a component name is given which does not
+	 correspond to any component of the defined structure.  */
+      if (!this_comp)
+	goto cleanup;
 
-	  /* Find the current component in the structure definition and check
-	     its access is not private.  */
-	  if (comp)
-	    this_comp = gfc_find_component (sym, comp->name, false, false);
-	  else
-	    {
-	      this_comp = gfc_find_component (sym,
-					      (const char *)comp_tail->name,
-					      false, false);
-	      comp = NULL; /* Reset needed!  */
-	    }
+      comp_tail->val = actual->expr;
+      if (actual->expr != NULL)
+	comp_tail->where = actual->expr->where;
+      actual->expr = NULL;
 
-	  /* Here we can check if a component name is given which does not
-	     correspond to any component of the defined structure.  */
-	  if (!this_comp)
-	    goto cleanup;
-
-	  /* Check if this component is already given a value.  */
-	  for (comp_iter = comp_head; comp_iter != comp_tail; 
-	       comp_iter = comp_iter->next)
+      /* Check if this component is already given a value.  */
+      for (comp_iter = comp_head; comp_iter != comp_tail; 
+	   comp_iter = comp_iter->next)
+	{
+	  gcc_assert (comp_iter);
+	  if (!strcmp (comp_iter->name, comp_tail->name))
 	    {
-	      gcc_assert (comp_iter);
-	      if (!strcmp (comp_iter->name, comp_tail->name))
-		{
-		  gfc_error ("Component '%s' is initialized twice in the"
-			     " structure constructor at %C!", comp_tail->name);
-		  goto cleanup;
-		}
+	      gfc_error ("Component '%s' is initialized twice in the structure"
+			 " constructor at %L!", comp_tail->name,
+			 comp_tail->val ? &comp_tail->where
+					: &gfc_current_locus);
+	      goto cleanup;
 	    }
+	}
 
-	  /* Match the current initializer expression.  */
-	  if (this_comp->attr.proc_pointer)
-	    gfc_matching_procptr_assignment = 1;
-	  m = gfc_match_expr (&comp_tail->val);
-	  gfc_matching_procptr_assignment = 0;
-	  if (m == MATCH_NO)
-	    goto syntax;
-	  if (m == MATCH_ERROR)
-	    goto cleanup;
+      /* F2008, R457/C725, for PURE C1283.  */
+      if (this_comp->attr.pointer && comp_tail->val
+	  && gfc_is_coindexed (comp_tail->val))
+     	{
+       	  gfc_error ("Coindexed expression to pointer component '%s' in "
+		     "structure constructor at %L!", comp_tail->name,
+		     &comp_tail->where);
+	  goto cleanup;
+	}
 
-	  /* F2008, R457/C725, for PURE C1283.  */
-          if (this_comp->attr.pointer && gfc_is_coindexed (comp_tail->val))
-	    {
-	      gfc_error ("Coindexed expression to pointer component '%s' in "
-			 "structure constructor at %C!", comp_tail->name);
-	      goto cleanup;
- 	    }
+          /* If not explicitly a parent constructor, gather up the components
+             and build one.  */
+          if (comp && comp == sym->components
+                && sym->attr.extension
+		&& comp_tail->val
+                && (comp_tail->val->ts.type != BT_DERIVED
+                      ||
+                    comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
+            {
+              gfc_try m;
+	      gfc_actual_arglist *arg_null = NULL;
 
-
-	  /* If not explicitly a parent constructor, gather up the components
-	     and build one.  */
-	  if (comp && comp == sym->components
-		&& sym->attr.extension
-		&& (comp_tail->val->ts.type != BT_DERIVED
-		      ||
-		    comp_tail->val->ts.u.derived != this_comp->ts.u.derived))
-	    {
-	      gfc_current_locus = where;
-	      gfc_free_expr (comp_tail->val);
+	      actual->expr = comp_tail->val;
 	      comp_tail->val = NULL;
 
-	      m = gfc_match_structure_constructor (comp->ts.u.derived, 
-						   &comp_tail->val, true);
-	      if (m == MATCH_NO)
-		goto syntax;
-	      if (m == MATCH_ERROR)
-		goto cleanup;
-	    }
+              m = gfc_convert_to_structure_constructor (NULL,
+					comp->ts.u.derived, &comp_tail->val,
+					comp->ts.u.derived->attr.zero_comp
+					  ? &arg_null : &actual, true);
+              if (m == FAILURE)
+                goto cleanup;
 
- 	  if (comp)
-	    comp = comp->next;
+	      if (comp->ts.u.derived->attr.zero_comp)
+		{
+		  comp = comp->next;
+		  continue;
+		}
+            }
 
-	  if (parent && !comp)
-	    break;
-	}
+      if (comp)
+	comp = comp->next;
+      if (parent && !comp)
+	break;
 
-      while (gfc_match_char (',') == MATCH_YES);
-
-      if (!parent && gfc_match_char (')') != MATCH_YES)
-	goto syntax;
+      actual = actual->next;
     }
 
   if (build_actual_constructor (&comp_head, &ctor_head, sym) == FAILURE)
@@ -2488,9 +2479,8 @@  build_actual_constructor (gfc_structure_ctor_compo
   /* No component should be left, as this should have caused an error in the
      loop constructing the component-list (name that does not correspond to any
      component in the structure definition).  */
-  if (comp_head)
+  if (comp_head && sym->attr.extension)
     {
-      gcc_assert (sym->attr.extension);
       for (comp_iter = comp_head; comp_iter; comp_iter = comp_iter->next)
 	{
 	  gfc_error ("component '%s' at %L has already been set by a "
@@ -2499,18 +2489,33 @@  build_actual_constructor (gfc_structure_ctor_compo
 	}
       goto cleanup;
     }
+  else
+    gcc_assert (!comp_head);
 
-  e = gfc_get_structure_constructor_expr (BT_DERIVED, 0, &where);
-  e->ts.u.derived = sym;
-  e->value.constructor = ctor_head;
+  if (parent)
+    {
+      expr = gfc_get_structure_constructor_expr (BT_DERIVED, 0, &gfc_current_locus);
+      expr->ts.u.derived = sym;
+      expr->value.constructor = ctor_head;
+      *cexpr = expr;
+    }
+  else
+    {
+      expr->ts.u.derived = sym;
+      expr->ts.kind = 0;
+      expr->ts.type = BT_DERIVED;
+      expr->value.constructor = ctor_head;
+      expr->expr_type = EXPR_STRUCTURE;
+    }
 
-  *result = e;
-  return MATCH_YES;
+  gfc_current_locus = old_locus; 
+  if (parent)
+    *arglist = actual;
+  return SUCCESS;
 
-syntax:
-  gfc_error ("Syntax error in structure constructor at %C");
+  cleanup:
+  gfc_current_locus = old_locus; 
 
-cleanup:
   for (comp_iter = comp_head; comp_iter; )
     {
       gfc_structure_ctor_component *next = comp_iter->next;
@@ -2518,10 +2523,48 @@  build_actual_constructor (gfc_structure_ctor_compo
       comp_iter = next;
     }
   gfc_constructor_free (ctor_head);
-  return MATCH_ERROR;
+
+  return FAILURE;
 }
 
 
+match
+gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result)
+{
+  match m;
+  gfc_expr *e;
+  gfc_symtree *symtree;
+
+  gfc_get_sym_tree (sym->name, NULL, &symtree, false);   /* Can't fail */
+
+  e = gfc_get_expr ();
+  e->symtree = symtree;
+  e->expr_type = EXPR_FUNCTION;
+
+  gcc_assert (sym->attr.flavor == FL_DERIVED
+	      && symtree->n.sym->attr.flavor == FL_PROCEDURE);
+  e->value.function.esym = sym;
+  e->symtree->n.sym->attr.generic = 1;
+
+   m = gfc_match_actual_arglist (0, &e->value.function.actual);
+   if (m != MATCH_YES)
+     {
+       gfc_free_expr (e);
+       return m;
+     }
+
+   if (gfc_convert_to_structure_constructor (e, sym, NULL, NULL, false)
+       != SUCCESS)
+     {
+       gfc_free_expr (e);
+       return MATCH_ERROR;
+     }
+
+   *result = e;
+   return MATCH_YES;
+}
+
+
 /* If the symbol is an implicit do loop index and implicitly typed,
    it should not be host associated.  Provide a symtree from the
    current namespace.  */
@@ -2715,7 +2758,7 @@  gfc_match_rvalue (gfc_expr **result)
       if (sym == NULL)
 	m = MATCH_ERROR;
       else
-	m = gfc_match_structure_constructor (sym, &e, false);
+	goto generic_function;
       break;
 
     /* If we're here, then the name is known to be the name of a
@@ -2989,6 +3032,12 @@  gfc_match_rvalue (gfc_expr **result)
       e->symtree = symtree;
       e->expr_type = EXPR_FUNCTION;
 
+      if (sym->attr.flavor == FL_DERIVED)
+	{
+	  e->value.function.esym = sym;
+	  e->symtree->n.sym->attr.generic = 1;
+	}
+
       m = gfc_match_actual_arglist (0, &e->value.function.actual);
       break;