Доработка программы. Заменить подстроку в строке на инверсную - Free Pascal

Формулировка задачи:

Не могу устранить ошибку в работе программы. Если строка состоит из многократно повторяющихся символов, например шшшшшшшшшшшш, а подстрока, например, шш, то программа не работает. Помогите исправить.

Program invers;
uses strutils, strings,crt;
 
Procedure Input (var x,y:string);
begin
write ('Введите строку: ');
readln (x);
write ('Введите подстроку: ');
read (y);
end;
 
Procedure Conclusion (var x: string);
begin
write (x);
end;
 
function Invers (var x,y:string):string;
var m,n: integer;
k,i,j: string;
begin
   while (n>0) or (n<0) do
     begin
     n:=0;
     n:=pos (y,x);
     if (n=0) then break
     else
     k:=ReverseString(y);
     i:=copy (x,1,n-1);
     j:=copy (x,n+length(y),length(x));
     x:=i+k+j;
     end;
end;
 
var
x,y: string;
n,m: integer;
begin
 n:=0;
 clrscr;
 Input (x,y);
 n:=pos(y,x);
   if n=0 then writeln (y,' не является подстрокой введённой строки ')
   else
  n:=pos (y,x);
  Invers (x,y);
 Conclusion (x);
 readln;
 readln;
end.

Решение задачи: «Доработка программы. Заменить подстроку в строке на инверсную»

Листинг программы

var
  s, ss: String;
  i, j, p, q: Integer;
  t: Char;
begin
  Write('   Строка: '); ReadLn(s);
  Write('Подстрока: '); ReadLn(ss);
  i:=1; j:=Length(s)-Length(ss)+1;
  while i<=j do begin
    if Copy(s,i,Length(ss))=ss then begin
      p:=i; Inc(i,Length(ss)); q:=i-1;
      while p<q do begin
        t:=s[p]; s[p]:=s[q]; s[q]:=t; Inc(p); Dec(q);
      end;
    end else Inc(i);
  end;
  Write('Результат: '); WriteLn(s);
end.

Объяснение кода листинга программы

Объявлены переменные s, ss, i, j, p, q, t типа String и Integer
Пользователю предлагается ввести строку и подстроку
Вычисляются начальный и конечный индексы подстроки в строке
В цикле проверяется, совпадает ли текущий фрагмент строки с подстрокой
Если совпадает, то выполняется цикл, который меняет символы местами
Выводится результат