diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 31ed636b6462ea8dabc9af1ae1caf48b998fa815..c0b8d5afd143db4077d821c9705dd84301371335 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2011-02-18  Michael Matz  <matz@suse.de>
+
+	PR fortran/45586
+	* gfortran.h (struct gfc_component): Add norestrict_decl member.
+	* trans.h (struct lang_type): Add nonrestricted_type member.
+	* trans-expr.c (gfc_conv_component_ref): Search fields with correct
+	parent type.
+	* trans-types.c (mirror_fields, gfc_nonrestricted_type): New.
+	(gfc_sym_type): Use it.
+
 2011-02-18  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/47768
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index ae1253400f1d75d65533b8a722c72d20a563e2d0..b64fa2014e51878f2cb78b0568d6f23a54246d5d 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -934,6 +934,10 @@ typedef struct gfc_component
   gfc_array_spec *as;
 
   tree backend_decl;
+  /* Used to cache a FIELD_DECL matching this same component
+     but applied to a different backend containing type that was
+     generated by gfc_nonrestricted_type.  */
+  tree norestrict_decl;
   locus loc;
   struct gfc_expr *initializer;
   struct gfc_component *next;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b7d7ed95a6610456f618aad3d75d53d5897b5153..3cf8df56e4a1ef0bd65dd333d715e249bc5b8f3b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -504,6 +504,26 @@ gfc_conv_component_ref (gfc_se * se, gfc_ref * ref)
   field = c->backend_decl;
   gcc_assert (TREE_CODE (field) == FIELD_DECL);
   decl = se->expr;
+
+  /* Components can correspond to fields of different containing
+     types, as components are created without context, whereas
+     a concrete use of a component has the type of decl as context.
+     So, if the type doesn't match, we search the corresponding
+     FIELD_DECL in the parent type.  To not waste too much time
+     we cache this result in norestrict_decl.  */
+
+  if (DECL_FIELD_CONTEXT (field) != TREE_TYPE (decl))
+    {
+      tree f2 = c->norestrict_decl;
+      if (!f2 || DECL_FIELD_CONTEXT (f2) != TREE_TYPE (decl))
+	for (f2 = TYPE_FIELDS (TREE_TYPE (decl)); f2; f2 = DECL_CHAIN (f2))
+	  if (TREE_CODE (f2) == FIELD_DECL
+	      && DECL_NAME (f2) == DECL_NAME (field))
+	    break;
+      gcc_assert (f2);
+      c->norestrict_decl = f2;
+      field = f2;
+    }
   tmp = fold_build3_loc (input_location, COMPONENT_REF, TREE_TYPE (field),
 			 decl, field, NULL_TREE);
 
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 7c299741aec51f0e7b3e87f8bb07c50c161d45ef..0626a87ac468aac5e1e1b08fa7db1a0b50518582 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1746,6 +1746,171 @@ gfc_build_pointer_type (gfc_symbol * sym, tree type)
   else
     return build_pointer_type (type);
 }
+
+static tree gfc_nonrestricted_type (tree t);
+/* Given two record or union type nodes TO and FROM, ensure
+   that all fields in FROM have a corresponding field in TO,
+   their type being nonrestrict variants.  This accepts a TO
+   node that already has a prefix of the fields in FROM.  */
+static void
+mirror_fields (tree to, tree from)
+{
+  tree fto, ffrom;
+  tree *chain;
+
+  /* Forward to the end of TOs fields.  */
+  fto = TYPE_FIELDS (to);
+  ffrom = TYPE_FIELDS (from);
+  chain = &TYPE_FIELDS (to);
+  while (fto)
+    {
+      gcc_assert (ffrom && DECL_NAME (fto) == DECL_NAME (ffrom));
+      chain = &DECL_CHAIN (fto);
+      fto = DECL_CHAIN (fto);
+      ffrom = DECL_CHAIN (ffrom);
+    }
+
+  /* Now add all fields remaining in FROM (starting with ffrom).  */
+  for (; ffrom; ffrom = DECL_CHAIN (ffrom))
+    {
+      tree newfield = copy_node (ffrom);
+      DECL_CONTEXT (newfield) = to;
+      /* The store to DECL_CHAIN might seem redundant with the
+	 stores to *chain, but not clearing it here would mean
+	 leaving a chain into the old fields.  If ever
+	 our called functions would look at them confusion
+	 will arise.  */
+      DECL_CHAIN (newfield) = NULL_TREE;
+      *chain = newfield;
+      chain = &DECL_CHAIN (newfield);
+
+      if (TREE_CODE (ffrom) == FIELD_DECL)
+	{
+	  tree elemtype = gfc_nonrestricted_type (TREE_TYPE (ffrom));
+	  TREE_TYPE (newfield) = elemtype;
+	}
+    }
+  *chain = NULL_TREE;
+}
+
+/* Given a type T, returns a different type of the same structure,
+   except that all types it refers to (recursively) are always
+   non-restrict qualified types.  */
+static tree
+gfc_nonrestricted_type (tree t)
+{
+  tree ret = t;
+
+  /* If the type isn't layed out yet, don't copy it.  If something
+     needs it for real it should wait until the type got finished.  */
+  if (!TYPE_SIZE (t))
+    return t;
+
+  if (!TYPE_LANG_SPECIFIC (t))
+    TYPE_LANG_SPECIFIC (t)
+      = ggc_alloc_cleared_lang_type (sizeof (struct lang_type));
+  /* If we're dealing with this very node already further up
+     the call chain (recursion via pointers and struct members)
+     we haven't yet determined if we really need a new type node.
+     Assume we don't, return T itself.  */
+  if (TYPE_LANG_SPECIFIC (t)->nonrestricted_type == error_mark_node)
+    return t;
+
+  /* If we have calculated this all already, just return it.  */
+  if (TYPE_LANG_SPECIFIC (t)->nonrestricted_type)
+    return TYPE_LANG_SPECIFIC (t)->nonrestricted_type;
+
+  /* Mark this type.  */
+  TYPE_LANG_SPECIFIC (t)->nonrestricted_type = error_mark_node;
+
+  switch (TREE_CODE (t))
+    {
+      default:
+	break;
+
+      case POINTER_TYPE:
+      case REFERENCE_TYPE:
+	{
+	  tree totype = gfc_nonrestricted_type (TREE_TYPE (t));
+	  if (totype == TREE_TYPE (t))
+	    ret = t;
+	  else if (TREE_CODE (t) == POINTER_TYPE)
+	    ret = build_pointer_type (totype);
+	  else
+	    ret = build_reference_type (totype);
+	  ret = build_qualified_type (ret,
+				      TYPE_QUALS (t) & ~TYPE_QUAL_RESTRICT);
+	}
+	break;
+
+      case ARRAY_TYPE:
+	{
+	  tree elemtype = gfc_nonrestricted_type (TREE_TYPE (t));
+	  if (elemtype == TREE_TYPE (t))
+	    ret = t;
+	  else
+	    {
+	      ret = build_variant_type_copy (t);
+	      TREE_TYPE (ret) = elemtype;
+	      if (TYPE_LANG_SPECIFIC (t)
+		  && GFC_TYPE_ARRAY_DATAPTR_TYPE (t))
+		{
+		  tree dataptr_type = GFC_TYPE_ARRAY_DATAPTR_TYPE (t);
+		  dataptr_type = gfc_nonrestricted_type (dataptr_type);
+		  if (dataptr_type != GFC_TYPE_ARRAY_DATAPTR_TYPE (t))
+		    {
+		      TYPE_LANG_SPECIFIC (ret)
+			= ggc_alloc_cleared_lang_type (sizeof (struct
+							       lang_type));
+		      *TYPE_LANG_SPECIFIC (ret) = *TYPE_LANG_SPECIFIC (t);
+		      GFC_TYPE_ARRAY_DATAPTR_TYPE (ret) = dataptr_type;
+		    }
+		}
+	    }
+	}
+	break;
+
+      case RECORD_TYPE:
+      case UNION_TYPE:
+      case QUAL_UNION_TYPE:
+	{
+	  tree field;
+	  /* First determine if we need a new type at all.
+	     Careful, the two calls to gfc_nonrestricted_type per field
+	     might return different values.  That happens exactly when
+	     one of the fields reaches back to this very record type
+	     (via pointers).  The first calls will assume that we don't
+	     need to copy T (see the error_mark_node marking).  If there
+	     are any reasons for copying T apart from having to copy T,
+	     we'll indeed copy it, and the second calls to
+	     gfc_nonrestricted_type will use that new node if they
+	     reach back to T.  */
+	  for (field = TYPE_FIELDS (t); field; field = DECL_CHAIN (field))
+	    if (TREE_CODE (field) == FIELD_DECL)
+	      {
+		tree elemtype = gfc_nonrestricted_type (TREE_TYPE (field));
+		if (elemtype != TREE_TYPE (field))
+		  break;
+	      }
+	  if (!field)
+	    break;
+	  ret = build_variant_type_copy (t);
+	  TYPE_FIELDS (ret) = NULL_TREE;
+
+	  /* Here we make sure that as soon as we know we have to copy
+	     T, that also fields reaching back to us will use the new
+	     copy.  It's okay if that copy still contains the old fields,
+	     we won't look at them.  */
+	  TYPE_LANG_SPECIFIC (t)->nonrestricted_type = ret;
+	  mirror_fields (ret, t);
+	}
+        break;
+    }
+
+  TYPE_LANG_SPECIFIC (t)->nonrestricted_type = ret;
+  return ret;
+}
+
 
 /* Return the type for a symbol.  Special handling is required for character
    types to get the correct level of indirection.
@@ -1796,6 +1961,9 @@ gfc_sym_type (gfc_symbol * sym)
 
   restricted = !sym->attr.target && !sym->attr.pointer
                && !sym->attr.proc_pointer && !sym->attr.cray_pointee;
+  if (!restricted)
+    type = gfc_nonrestricted_type (type);
+
   if (sym->attr.dimension)
     {
       if (gfc_is_nodesc_array (sym))
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 26ac0039e8d888061ff35ef1940cc34aeb2bb518..9695c5a4db14eec91cbc2f9493a34f40476a07fe 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -700,6 +700,7 @@ struct GTY((variable_size))	lang_type	 {
   tree dataptr_type;
   tree span;
   tree base_decl[2];
+  tree nonrestricted_type;
 };
 
 struct GTY((variable_size)) lang_decl {
diff --git a/gcc/testsuite/gfortran.dg/lto/pr45586_0.f90 b/gcc/testsuite/gfortran.dg/lto/pr45586_0.f90
new file mode 100644
index 0000000000000000000000000000000000000000..84f3633df744d44227cb47fece68519432716c88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/lto/pr45586_0.f90
@@ -0,0 +1,29 @@
+! { dg-lto-do link }
+      MODULE M1
+      INTEGER, PARAMETER :: dp=8
+      TYPE realspace_grid_type
+
+          REAL(KIND=dp), DIMENSION ( :, :, : ), ALLOCATABLE :: r
+
+      END TYPE realspace_grid_type
+      END MODULE
+
+      MODULE M2
+      USE m1
+      CONTAINS
+      SUBROUTINE S1(x)
+      TYPE(realspace_grid_type), POINTER :: x
+      REAL(dp), DIMENSION(:, :, :), POINTER    :: y
+      y=>x%r
+      y=0
+
+      END SUBROUTINE
+      END MODULE
+
+      USE M2
+      TYPE(realspace_grid_type), POINTER :: x
+      ALLOCATE(x)
+      ALLOCATE(x%r(10,10,10))
+      CALL S1(x)
+      write(6,*) x%r
+      END
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_20.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4fee2f3bab2f26f73f552acbad2b3625df027d50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_20.f90
@@ -0,0 +1,68 @@
+! { dg-do compile }
+! TODO: make runtime testcase once bug is fixed
+!
+! PR fortran/47455
+!
+! Based on an example by Thomas Henlich
+!
+
+module class_t
+    type :: tx
+        integer, dimension(:), allocatable :: i
+    end type tx
+    type :: t
+        type(tx), pointer :: x
+        type(tx) :: y
+    contains
+        procedure :: calc
+        procedure :: find_x
+        procedure :: find_y
+    end type t
+contains
+    subroutine calc(this)
+        class(t), target :: this
+        type(tx), target :: that
+        that%i = [1,2]
+        this%x => this%find_x(that, .true.)
+        if (associated (this%x)) call abort()
+        this%x => this%find_x(that, .false.)
+        if(any (this%x%i /= [5, 7])) call abort()
+        if (.not.associated (this%x,that)) call abort()
+        allocate(this%x)
+        if (associated (this%x,that)) call abort()
+        if (allocated(this%x%i)) call abort()
+        this%x = this%find_x(that, .false.)
+        that%i = [3,4]
+        if(any (this%x%i /= [5, 7])) call abort() ! FAILS
+
+        if (allocated (this%y%i)) call abort()
+        this%y = this%find_y()  ! FAILS
+        if (.not.allocated (this%y%i)) call abort()
+        if(any (this%y%i /= [6, 8])) call abort()
+    end subroutine calc
+    function find_x(this, that, l_null)
+       class(t), intent(in) :: this
+       type(tx), target  :: that
+       type(tx), pointer :: find_x
+       logical :: l_null
+       if (l_null) then
+         find_x => null()
+       else
+         find_x => that
+         that%i = [5, 7]
+       end if
+    end function find_x
+    function find_y(this) result(res)
+        class(t), intent(in) :: this
+        type(tx), allocatable :: res
+        allocate(res)
+        res%i = [6, 8]
+   end function find_y
+end module class_t
+
+use class_t
+type(t) :: x
+call x%calc()
+end
+
+! { dg-final { cleanup-modules "class_t" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_21.f90 b/gcc/testsuite/gfortran.dg/typebound_proc_21.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6c16d46ff2ce8bf855d969b52a28df88632d5e8e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_21.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR fortran/47455
+!
+module class_t
+    type :: tx
+        integer, dimension(:), allocatable :: i
+    end type tx
+    type :: t
+        type(tx), pointer :: x
+    contains
+        procedure :: calc
+        procedure :: find_x
+    end type t
+contains
+    subroutine calc(this)
+        class(t), target :: this
+        this%x = this%find_x()
+    end subroutine calc
+    function find_x(this)
+        class(t), intent(in) :: this
+        type(tx), pointer :: find_x
+        find_x => null()
+    end function find_x
+end module class_t
+
+! { dg-final { cleanup-modules "class_t" } }