Программа неожиданно корректно завершается в процедуре, без halt - Free Pascal
Формулировка задачи:
Функция WithList (строка 330) нормально выполняется, однако после ее завершения программа так же завершается. Остальные два пункта нормально работают.
Не могу пошагово выполнять ибо FP заглючивает и приходится перезагружаться.
С помощью вывода текста выяснила что после третьего пункта в цикле в основной части программы возвращения в этот цикл так и не происходит, после остальных двух пунктов все нормально.
Как это возможно и как исправить?
input.txt приложила
Листинг программы
- uses crt;
- type
- intfile = file of integer;
- pList = ^List;
- List = record
- data: integer;
- next: pList;
- end;
- //------------------------------------------------------------------
- procedure Sort(var a: array of integer); overload;
- var
- n, i, j, tmp: integer;
- begin
- n := length(a);
- for i := n - n mod 2 - 4 downto 0 do
- if i mod 2 = 0 then
- for j := 0 to i do
- if j mod 2 = 0 then
- if a[j]+a[j+1] > a[j+2]+a[j+3] then
- begin
- tmp := a[j];
- a[j] := a[j+2];
- a[j+2] := tmp;
- tmp := a[j+1];
- a[j+1] := a[j+3];
- a[j+3] := tmp;
- end;
- end;
- //------------------------------------------------------------------
- function Delete(var a: array of integer; val: integer): boolean; overload;
- var
- n, i, j: integer;
- begin
- n := length(a);
- for i := 0 to n-2 do
- if i mod 2 = 0 then
- if a[i]+a[i+1] = val then
- begin
- for j := i to n-3 do
- a[j] := a[j+2];
- Delete := true;
- exit;
- end;
- Delete := false;
- end;
- //------------------------------------------------------------------
- procedure Print(a: array of integer); overload;
- var
- i: integer;
- begin
- for i := 0 to length(a)-1 do
- write(a[i], ' ');
- writeln;
- end;
- //------------------------------------------------------------------
- procedure WithArray(var f: text);
- var
- a: array of integer;
- n, i, m: integer;
- begin
- reset(f);
- read(f, n);
- setlength(a, n);
- for i := 0 to n-1 do
- read(f, a[i]);
- close(f);
- write('Ishodnyi massiv: ');
- Print(a);
- Sort(a);
- write('Posle sortirovki: ');
- Print(a);
- write('Vvedite summu dlea udalenia: ');
- readln(m);
- if Delete(a, m) then
- begin
- setlength(a, n-2);
- write('Posle udalenia: ');
- Print(a);
- end
- else
- writeln('Para s ukazannoi summoi ne naidena!');
- readkey;
- end;
- //------------------------------------------------------------------
- procedure TextToTypeFile(var f1: text; var f2: intfile);
- var
- n, i, cur: integer;
- begin
- rewrite(f2);
- read(f1, n);
- for i := 1 to n do
- begin
- read(f1, cur);
- write(f2, cur);
- end;
- close(f2);
- end;
- //------------------------------------------------------------------
- procedure Sort(var f: intfile); overload;
- var
- cur: array [0..3] of integer;
- changed: boolean;
- begin
- changed := true;
- while changed do
- begin
- changed := false;
- reset(f);
- read(f, cur[2], cur[3]);
- while not eof(f) do
- begin
- cur[0] := cur[2];
- cur[1] := cur[3];
- read(f, cur[2]);
- if not eof(f) then
- read(f, cur[3])
- else
- break;
- if cur[0]+cur[1] > cur[2]+cur[3] then
- begin
- seek(f, filepos(f)-4);
- write(f, cur[2], cur[3], cur[0], cur[1]);
- changed := true;
- end;
- end;
- end;
- close(f);
- end;
- //------------------------------------------------------------------
- function Delete(var f: intfile; m: integer): boolean; overload;
- var
- cur1, cur2: integer;
- found: boolean;
- begin
- reset(f);
- found := false;
- while not eof(f) and not found do
- begin
- read(f, cur1);
- if not eof(f) then
- read(f, cur2)
- else
- break;
- if cur1+cur2 = m then
- begin
- while not eof(f) do
- begin
- read(f, cur1);
- if not eof(f) then
- read(f, cur2)
- else
- begin
- seek(f, filepos(f)-3);
- write(f, cur1);
- break;
- end;
- seek(f, filepos(f)-4);
- write(f, cur1, cur2);
- seek(f, filepos(f)+2);
- if eof(f) then
- begin
- seek(f, filepos(f)-2);
- break;
- end;
- end;
- truncate(f);
- found := true;
- end;
- end;
- close(f);
- Delete := found;
- end;
- //------------------------------------------------------------------
- procedure Print(var f: intfile); overload;
- var
- cur: integer;
- begin
- reset(f);
- while not eof(f) do
- begin
- read(f, cur);
- write(cur, ' ');
- end;
- writeln;
- close(f);
- end;
- //------------------------------------------------------------------
- procedure WithTypeFile(var f: text);
- var
- typef: intfile;
- m: integer;
- begin
- assign(typef, 'file_of_integer');
- reset(f);
- TextToTypeFile(f, typef);
- write('Soderjimoe tipizirovannogo faila: ');
- Print(typef);
- write('Posle sortirovki: ');
- Sort(typef);
- Print(typef);
- write('Vvedite summu dlea udalenia: ');
- readln(m);
- if Delete(typef, m) then
- begin
- write('Posle udalenia: ');
- Print(typef);
- end
- else
- writeln('Para s ukazannoi summoi ne naidena!');
- readkey;
- end;
- //------------------------------------------------------------------
- procedure FileToList(var f: text; var first: pList);
- var
- n, i: integer;
- newelem, last: pList;
- begin
- first := nil;
- last := nil;
- reset(f);
- read(f, n);
- for i := 1 to n do
- begin
- new(newelem);
- read(f, newelem^.data);
- newelem^.next := nil;
- if last <> nil then
- last^.next := newelem
- else
- first := newelem;
- last := newelem;
- end;
- close(f);
- end;
- //------------------------------------------------------------------
- procedure Sort(first: pList); overload;
- var
- cur: array [0..3] of pList;
- tmp: integer;
- changed: boolean;
- begin
- changed := true;
- while changed do
- begin
- changed := false;
- cur[2] := first;
- if first <> nil then
- cur[3] := first^.next
- else
- cur[3] := nil;
- while (cur[3] <> nil) and (cur[3]^.next <> nil) do
- begin
- cur[0] := cur[2];
- cur[1] := cur[3];
- cur[2] := cur[1]^.next;
- cur[3] := cur[2]^.next;
- if cur[3] = nil then
- break;
- if cur[0]^.data+cur[1]^.data > cur[2]^.data+cur[3]^.data then
- begin
- tmp := cur[0]^.data;
- cur[0]^.data := cur[2]^.data;
- cur[2]^.data := tmp;
- tmp := cur[1]^.data;
- cur[1]^.data := cur[3]^.data;
- cur[3]^.data := tmp;
- changed := true;
- end;
- end;
- end;
- end;
- //------------------------------------------------------------------
- function Delete(var first: pList; m: integer): boolean; overload;
- var
- prev, cur1, cur2: pList;
- found: boolean;
- begin
- found := false;
- prev := nil;
- cur1 := first;
- if cur1 <> nil then
- cur2 := cur1^.next;
- while not found and (cur1 <> nil) and (cur2 <> nil) do
- if cur1^.data+cur2^.data = m then
- begin
- if prev <> nil then
- prev^.next := cur2^.next
- else
- first := cur2^.next;
- dispose(cur1);
- dispose(cur2);
- found := true;
- end
- else
- begin
- prev := cur2;
- cur1 := cur2^.next;
- if cur1 <> nil then
- cur2 := cur1^.next;
- end;
- Delete := found;
- end;
- //------------------------------------------------------------------
- procedure Clear(var first: pList);
- var
- tmp: pList;
- begin
- while first <> nil do
- begin
- tmp := first;
- first := first^.next;
- dispose(tmp);
- end;
- end;
- //------------------------------------------------------------------
- procedure Print(first: pList); overload;
- var
- cur: pList;
- begin
- cur := first;
- while cur <> nil do
- begin
- write(cur^.data, ' ');
- cur := cur^.next;
- end;
- writeln;
- end;
- //------------------------------------------------------------------
- procedure WithList(var f: text);
- var
- first: pList;
- m: integer;
- begin
- reset(f);
- FileToList(f, first);
- write('Ishodnyi spisok: ');
- Print(first);
- Sort(first);
- write('Posle sortirovki: ');
- Print(first);
- write('Vvedite summu dlea udalenia: ');
- readln(m);
- if Delete(first, m) then
- begin
- write('Posle udalenia: ');
- Print(first);
- end
- else
- writeln('Para s ukazannoi summoi ne naidena!');
- Clear(first);
- writeln('Spisok ochischen');
- close(f);
- readkey;
- end;
- //------------------------------------------------------------------
- function Menu: integer;
- var
- choice: integer;
- begin
- clrscr;
- writeln('1 - Rabota s massivom');
- writeln('2 - Rabota s tipizirovannym failom');
- writeln('3 - Rabota so spiskom');
- writeln('0 - Vyhod iz programmy');
- write('Vash vybor: ');
- readln(choice);
- writeln;
- Menu := choice;
- end;
- //------------------------------------------------------------------
- var
- f: text;
- begin
- assign(f, 'input.txt');
- while true do
- case Menu of
- 0: break;
- 1: WithArray(f);
- 2: WithTypeFile(f);
- 3: WithList(f);
- end;
- end.
Решение задачи: «Программа неожиданно корректно завершается в процедуре, без halt»
textual
Листинг программы
- procedure WithList(var f: text);
- var
- first: pList;
- m: integer;
- begin
- reset(f);
- FileToList(f, first); // в этой процедуре файл f открывается/закрывается
- write('Ishodnyi spisok: ');
- Print(first);
- Sort(first);
- write('Posle sortirovki: ');
- Print(first);
- write('Vvedite summu dlea udalenia: ');
- readln(m);
- if Delete(first, m) then
- begin
- write('Posle udalenia: ');
- Print(first);
- end
- else
- writeln('Para s ukazannoi summoi ne naidena!');
- Clear(first);
- writeln('Spisok ochischen');
- close(f); // Но файл УЖЕ закрыт, не нужно перезакрывать его, чревато ошибками, ты видела какими :)
- readkey;
- end;
Объяснение кода листинга программы
- Объявлены следующие переменные:
- first: pList;
- m: integer;
- Вызов функции reset(f), которая открывает файл f для чтения.
- Вызов функции FileToList(f, first), которая заполняет список first содержимым файла f.
- Вывод сообщения
Ishodnyi spisok:
и вызов функции Print(first), которая выводит список first на экран. - Вызов функции Sort(first), которая сортирует список first по возрастанию.
- Вывод сообщения
Posle sortirovki:
и вызов функции Print(first), которая выводит отсортированный список на экран. - Вывод сообщения
Vvedite summu dlia udalenia:
и вызов функции readln(m), которая считывает с клавиатуры целое число и сохраняет его в переменной m. - Проверка условия Delete(first, m) (удаление элемента из списка по индексу).
- Если условие истинно, то выполняются действия:
- Вывод сообщения
Posle udalenia:
и вызов функции Print(first), которая выводит список first на экран. - Закрытие списка first с помощью функции Clear(first).
- Вывод сообщения
Spisok ochischen
и закрытие файла f с помощью функции close(f). - Ожидание нажатия клавиши с помощью функции readkey.
- Если условие ложно, то выводится сообщение
Para s ukazannoi summoi ne naidena!
.
- Файл УЖЕ закрыт, не нужно перезакрывать его, чревато ошибками.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д