Index: lra-constraints.c
===================================================================
--- lra-constraints.c	(revision 193557)
+++ lra-constraints.c	(working copy)
@@ -4633,6 +4633,21 @@ inherit_in_ebb (rtx head, rtx tail)
   return change_p;
 }
 
+/* The maximal number of inheritance/split passes in LRA.  It should
+   be more 1 in order to perform caller saves transformations and much
+   less MAX_CONSTRAINT_ITERATION_NUMBER to prevent LRA to do as many
+   as permitted constraint passes in some complicated cases.  The
+   first inheritance/split pass has a biggest impact on generated code
+   quality.  Each subsequent affects generated code in less degree.
+   For example, the 3rd pass does not change generated SPEC2000 code
+   at all on x86-64.  */
+#define MAX_INHERITANCE_PASSES 2
+
+#if MAX_INHERITANCE_PASSES <= 0 \
+    || MAX_INHERITANCE_PASSES >= MAX_CONSTRAINT_ITERATION_NUMBER - 8
+#error wrong MAX_INHERITANCE_PASSES value
+#endif
+
 /* This value affects EBB forming.  If probability of edge from EBB to
    a BB is not greater than the following value, we don't add the BB
    to EBB.  */
@@ -4649,8 +4664,10 @@ lra_inheritance (void)
   basic_block bb, start_bb;
   edge e;
 
-  timevar_push (TV_LRA_INHERITANCE);
   lra_inheritance_iter++;
+  if (lra_inheritance_iter > MAX_INHERITANCE_PASSES)
+    return;
+  timevar_push (TV_LRA_INHERITANCE);
   if (lra_dump_file != NULL)
     fprintf (lra_dump_file, "\n********** Inheritance #%d: **********\n\n",
 	     lra_inheritance_iter);
@@ -4920,6 +4937,8 @@ lra_undo_inheritance (void)
   bool change_p;
 
   lra_undo_inheritance_iter++;
+  if (lra_undo_inheritance_iter > MAX_INHERITANCE_PASSES)
+    return false;
   if (lra_dump_file != NULL)
     fprintf (lra_dump_file,
 	     "\n********** Undoing inheritance #%d: **********\n\n",
Index: testsuite/gfortran.dg/pr55330.f90
===================================================================
--- testsuite/gfortran.dg/pr55330.f90	(revision 0)
+++ testsuite/gfortran.dg/pr55330.f90	(working copy)
@@ -0,0 +1,73 @@
+! PR rtl-optimization/55330
+! { dg-do compile }
+! { dg-options "-O -fPIC -fno-dse -fno-guess-branch-probability" }
+
+module global
+  public    p, line
+  interface p
+    module procedure p
+  end interface
+  character(128) :: line = 'abcdefghijklmnopqrstuvwxyz'
+contains
+  subroutine p()
+    character(128) :: word
+    word = line
+    call redirect_((/word/))
+  end subroutine
+  subroutine redirect_ (ch)
+    character(*) :: ch(:)
+    if (ch(1) /= line) call abort ()
+  end subroutine redirect_
+end module global
+
+module my_module
+  implicit none
+  type point
+    real :: x
+  end type point
+  type(point), pointer, public :: stdin => NULL()
+contains
+  subroutine my_p(w)
+    character(128) :: w
+    call r(stdin,(/w/))
+  end subroutine my_p
+  subroutine r(ptr, io)
+    use global
+    type(point), pointer :: ptr
+    character(128) :: io(:)
+    if (associated (ptr)) call abort ()
+    if (io(1) .ne. line) call abort ()
+  end subroutine r
+end module my_module
+
+program main
+  use global
+  use my_module
+
+  integer :: i(6) = (/1,6,3,4,5,2/)
+  character (6) :: a = 'hello ', t
+  character(len=1) :: s(6) = (/'g','g','d','d','a','o'/)
+  equivalence (s, t)
+
+  call option_stopwatch_s (a)
+  call p ()
+  call my_p (line)
+
+  s = s(i)
+  call option_stopwatch_a ((/a,'hola! ', t/))
+
+contains
+
+  subroutine option_stopwatch_s(a)
+    character (*), intent(in) :: a
+    character (len=len(a)) :: b
+
+    b = 'hola! '
+    call option_stopwatch_a((/a, b, 'goddag'/))
+  end subroutine option_stopwatch_s 
+  subroutine option_stopwatch_a (a)
+    character (*) :: a(:)
+    if (any (a .ne. (/'hello ','hola! ','goddag'/))) call abort ()
+  end subroutine option_stopwatch_a
+
+end program main