Программа неожиданно корректно завершается в процедуре, без halt - Free Pascal

Узнай цену своей работы

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

Функция WithList (строка 330) нормально выполняется, однако после ее завершения программа так же завершается. Остальные два пункта нормально работают. Не могу пошагово выполнять ибо FP заглючивает и приходится перезагружаться. С помощью вывода текста выяснила что после третьего пункта в цикле в основной части программы возвращения в этот цикл так и не происходит, после остальных двух пунктов все нормально. Как это возможно и как исправить? input.txt приложила
Листинг программы
  1. uses crt;
  2. type
  3. intfile = file of integer;
  4. pList = ^List;
  5. List = record
  6. data: integer;
  7. next: pList;
  8. end;
  9. //------------------------------------------------------------------
  10. procedure Sort(var a: array of integer); overload;
  11. var
  12. n, i, j, tmp: integer;
  13. begin
  14. n := length(a);
  15. for i := n - n mod 2 - 4 downto 0 do
  16. if i mod 2 = 0 then
  17. for j := 0 to i do
  18. if j mod 2 = 0 then
  19. if a[j]+a[j+1] > a[j+2]+a[j+3] then
  20. begin
  21. tmp := a[j];
  22. a[j] := a[j+2];
  23. a[j+2] := tmp;
  24. tmp := a[j+1];
  25. a[j+1] := a[j+3];
  26. a[j+3] := tmp;
  27. end;
  28. end;
  29. //------------------------------------------------------------------
  30. function Delete(var a: array of integer; val: integer): boolean; overload;
  31. var
  32. n, i, j: integer;
  33. begin
  34. n := length(a);
  35. for i := 0 to n-2 do
  36. if i mod 2 = 0 then
  37. if a[i]+a[i+1] = val then
  38. begin
  39. for j := i to n-3 do
  40. a[j] := a[j+2];
  41. Delete := true;
  42. exit;
  43. end;
  44. Delete := false;
  45. end;
  46. //------------------------------------------------------------------
  47. procedure Print(a: array of integer); overload;
  48. var
  49. i: integer;
  50. begin
  51. for i := 0 to length(a)-1 do
  52. write(a[i], ' ');
  53. writeln;
  54. end;
  55. //------------------------------------------------------------------
  56. procedure WithArray(var f: text);
  57. var
  58. a: array of integer;
  59. n, i, m: integer;
  60. begin
  61. reset(f);
  62. read(f, n);
  63. setlength(a, n);
  64. for i := 0 to n-1 do
  65. read(f, a[i]);
  66. close(f);
  67. write('Ishodnyi massiv: ');
  68. Print(a);
  69. Sort(a);
  70. write('Posle sortirovki: ');
  71. Print(a);
  72. write('Vvedite summu dlea udalenia: ');
  73. readln(m);
  74. if Delete(a, m) then
  75. begin
  76. setlength(a, n-2);
  77. write('Posle udalenia: ');
  78. Print(a);
  79. end
  80. else
  81. writeln('Para s ukazannoi summoi ne naidena!');
  82. readkey;
  83. end;
  84. //------------------------------------------------------------------
  85. procedure TextToTypeFile(var f1: text; var f2: intfile);
  86. var
  87. n, i, cur: integer;
  88. begin
  89. rewrite(f2);
  90. read(f1, n);
  91. for i := 1 to n do
  92. begin
  93. read(f1, cur);
  94. write(f2, cur);
  95. end;
  96. close(f2);
  97. end;
  98. //------------------------------------------------------------------
  99. procedure Sort(var f: intfile); overload;
  100. var
  101. cur: array [0..3] of integer;
  102. changed: boolean;
  103. begin
  104. changed := true;
  105. while changed do
  106. begin
  107. changed := false;
  108. reset(f);
  109. read(f, cur[2], cur[3]);
  110. while not eof(f) do
  111. begin
  112. cur[0] := cur[2];
  113. cur[1] := cur[3];
  114. read(f, cur[2]);
  115. if not eof(f) then
  116. read(f, cur[3])
  117. else
  118. break;
  119. if cur[0]+cur[1] > cur[2]+cur[3] then
  120. begin
  121. seek(f, filepos(f)-4);
  122. write(f, cur[2], cur[3], cur[0], cur[1]);
  123. changed := true;
  124. end;
  125. end;
  126. end;
  127. close(f);
  128. end;
  129. //------------------------------------------------------------------
  130. function Delete(var f: intfile; m: integer): boolean; overload;
  131. var
  132. cur1, cur2: integer;
  133. found: boolean;
  134. begin
  135. reset(f);
  136. found := false;
  137. while not eof(f) and not found do
  138. begin
  139. read(f, cur1);
  140. if not eof(f) then
  141. read(f, cur2)
  142. else
  143. break;
  144. if cur1+cur2 = m then
  145. begin
  146. while not eof(f) do
  147. begin
  148. read(f, cur1);
  149. if not eof(f) then
  150. read(f, cur2)
  151. else
  152. begin
  153. seek(f, filepos(f)-3);
  154. write(f, cur1);
  155. break;
  156. end;
  157. seek(f, filepos(f)-4);
  158. write(f, cur1, cur2);
  159. seek(f, filepos(f)+2);
  160. if eof(f) then
  161. begin
  162. seek(f, filepos(f)-2);
  163. break;
  164. end;
  165. end;
  166. truncate(f);
  167. found := true;
  168. end;
  169. end;
  170. close(f);
  171. Delete := found;
  172. end;
  173. //------------------------------------------------------------------
  174. procedure Print(var f: intfile); overload;
  175. var
  176. cur: integer;
  177. begin
  178. reset(f);
  179. while not eof(f) do
  180. begin
  181. read(f, cur);
  182. write(cur, ' ');
  183. end;
  184. writeln;
  185. close(f);
  186. end;
  187. //------------------------------------------------------------------
  188. procedure WithTypeFile(var f: text);
  189. var
  190. typef: intfile;
  191. m: integer;
  192. begin
  193. assign(typef, 'file_of_integer');
  194. reset(f);
  195. TextToTypeFile(f, typef);
  196. write('Soderjimoe tipizirovannogo faila: ');
  197. Print(typef);
  198. write('Posle sortirovki: ');
  199. Sort(typef);
  200. Print(typef);
  201. write('Vvedite summu dlea udalenia: ');
  202. readln(m);
  203. if Delete(typef, m) then
  204. begin
  205. write('Posle udalenia: ');
  206. Print(typef);
  207. end
  208. else
  209. writeln('Para s ukazannoi summoi ne naidena!');
  210. readkey;
  211. end;
  212. //------------------------------------------------------------------
  213. procedure FileToList(var f: text; var first: pList);
  214. var
  215. n, i: integer;
  216. newelem, last: pList;
  217. begin
  218. first := nil;
  219. last := nil;
  220. reset(f);
  221. read(f, n);
  222. for i := 1 to n do
  223. begin
  224. new(newelem);
  225. read(f, newelem^.data);
  226. newelem^.next := nil;
  227. if last <> nil then
  228. last^.next := newelem
  229. else
  230. first := newelem;
  231. last := newelem;
  232. end;
  233. close(f);
  234. end;
  235. //------------------------------------------------------------------
  236. procedure Sort(first: pList); overload;
  237. var
  238. cur: array [0..3] of pList;
  239. tmp: integer;
  240. changed: boolean;
  241. begin
  242. changed := true;
  243. while changed do
  244. begin
  245. changed := false;
  246. cur[2] := first;
  247. if first <> nil then
  248. cur[3] := first^.next
  249. else
  250. cur[3] := nil;
  251. while (cur[3] <> nil) and (cur[3]^.next <> nil) do
  252. begin
  253. cur[0] := cur[2];
  254. cur[1] := cur[3];
  255. cur[2] := cur[1]^.next;
  256. cur[3] := cur[2]^.next;
  257. if cur[3] = nil then
  258. break;
  259. if cur[0]^.data+cur[1]^.data > cur[2]^.data+cur[3]^.data then
  260. begin
  261. tmp := cur[0]^.data;
  262. cur[0]^.data := cur[2]^.data;
  263. cur[2]^.data := tmp;
  264. tmp := cur[1]^.data;
  265. cur[1]^.data := cur[3]^.data;
  266. cur[3]^.data := tmp;
  267. changed := true;
  268. end;
  269. end;
  270. end;
  271. end;
  272. //------------------------------------------------------------------
  273. function Delete(var first: pList; m: integer): boolean; overload;
  274. var
  275. prev, cur1, cur2: pList;
  276. found: boolean;
  277. begin
  278. found := false;
  279. prev := nil;
  280. cur1 := first;
  281. if cur1 <> nil then
  282. cur2 := cur1^.next;
  283. while not found and (cur1 <> nil) and (cur2 <> nil) do
  284. if cur1^.data+cur2^.data = m then
  285. begin
  286. if prev <> nil then
  287. prev^.next := cur2^.next
  288. else
  289. first := cur2^.next;
  290. dispose(cur1);
  291. dispose(cur2);
  292. found := true;
  293. end
  294. else
  295. begin
  296. prev := cur2;
  297. cur1 := cur2^.next;
  298. if cur1 <> nil then
  299. cur2 := cur1^.next;
  300. end;
  301. Delete := found;
  302. end;
  303. //------------------------------------------------------------------
  304. procedure Clear(var first: pList);
  305. var
  306. tmp: pList;
  307. begin
  308. while first <> nil do
  309. begin
  310. tmp := first;
  311. first := first^.next;
  312. dispose(tmp);
  313. end;
  314. end;
  315. //------------------------------------------------------------------
  316. procedure Print(first: pList); overload;
  317. var
  318. cur: pList;
  319. begin
  320. cur := first;
  321. while cur <> nil do
  322. begin
  323. write(cur^.data, ' ');
  324. cur := cur^.next;
  325. end;
  326. writeln;
  327. end;
  328. //------------------------------------------------------------------
  329. procedure WithList(var f: text);
  330. var
  331. first: pList;
  332. m: integer;
  333. begin
  334. reset(f);
  335. FileToList(f, first);
  336. write('Ishodnyi spisok: ');
  337. Print(first);
  338. Sort(first);
  339. write('Posle sortirovki: ');
  340. Print(first);
  341. write('Vvedite summu dlea udalenia: ');
  342. readln(m);
  343. if Delete(first, m) then
  344. begin
  345. write('Posle udalenia: ');
  346. Print(first);
  347. end
  348. else
  349. writeln('Para s ukazannoi summoi ne naidena!');
  350. Clear(first);
  351. writeln('Spisok ochischen');
  352. close(f);
  353. readkey;
  354. end;
  355. //------------------------------------------------------------------
  356. function Menu: integer;
  357. var
  358. choice: integer;
  359. begin
  360. clrscr;
  361. writeln('1 - Rabota s massivom');
  362. writeln('2 - Rabota s tipizirovannym failom');
  363. writeln('3 - Rabota so spiskom');
  364. writeln('0 - Vyhod iz programmy');
  365. write('Vash vybor: ');
  366. readln(choice);
  367. writeln;
  368. Menu := choice;
  369. end;
  370. //------------------------------------------------------------------
  371. var
  372. f: text;
  373. begin
  374. assign(f, 'input.txt');
  375. while true do
  376. case Menu of
  377. 0: break;
  378. 1: WithArray(f);
  379. 2: WithTypeFile(f);
  380. 3: WithList(f);
  381. end;
  382. end.

Решение задачи: «Программа неожиданно корректно завершается в процедуре, без halt»

textual
Листинг программы
  1. procedure WithList(var f: text);
  2. var
  3.   first: pList;
  4.   m: integer;
  5. begin
  6.   reset(f);
  7.   FileToList(f, first); // в этой процедуре файл f открывается/закрывается
  8.   write('Ishodnyi spisok: ');
  9.   Print(first);
  10.   Sort(first);
  11.   write('Posle sortirovki: ');
  12.   Print(first);
  13.   write('Vvedite summu dlea udalenia: ');
  14.   readln(m);
  15.   if Delete(first, m) then
  16.   begin
  17.     write('Posle udalenia: ');
  18.     Print(first);
  19.   end
  20.   else
  21.     writeln('Para s ukazannoi summoi ne naidena!');
  22.   Clear(first);
  23.   writeln('Spisok ochischen');
  24.   close(f); // Но файл УЖЕ закрыт, не нужно перезакрывать его, чревато ошибками, ты видела какими :)
  25.   readkey;
  26. end;

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

  1. Объявлены следующие переменные:
    • first: pList;
    • m: integer;
  2. Вызов функции reset(f), которая открывает файл f для чтения.
  3. Вызов функции FileToList(f, first), которая заполняет список first содержимым файла f.
  4. Вывод сообщения Ishodnyi spisok: и вызов функции Print(first), которая выводит список first на экран.
  5. Вызов функции Sort(first), которая сортирует список first по возрастанию.
  6. Вывод сообщения Posle sortirovki: и вызов функции Print(first), которая выводит отсортированный список на экран.
  7. Вывод сообщения Vvedite summu dlia udalenia: и вызов функции readln(m), которая считывает с клавиатуры целое число и сохраняет его в переменной m.
  8. Проверка условия Delete(first, m) (удаление элемента из списка по индексу).
    • Если условие истинно, то выполняются действия:
    • Вывод сообщения Posle udalenia: и вызов функции Print(first), которая выводит список first на экран.
    • Закрытие списка first с помощью функции Clear(first).
    • Вывод сообщения Spisok ochischen и закрытие файла f с помощью функции close(f).
    • Ожидание нажатия клавиши с помощью функции readkey.
    • Если условие ложно, то выводится сообщение Para s ukazannoi summoi ne naidena!.
  9. Файл УЖЕ закрыт, не нужно перезакрывать его, чревато ошибками.

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

10   голосов , оценка 4.1 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы