Мультисписки

[Екатерина57]

Подскажите пожалуйста почему выходит за рамки массива?

const 
  count=3;
type 
  
 Pman=^Man;
  Man=record
    name    : string[10];
    alc_level:integer;
    smoke_level:integer;
    shown:boolean;
    next_alc:Pman;
    next_smoke:Pman;
  end;
  
var 
  alc:array [0..count] of Pman;
  smoke:array [0..count] of Pman;
  s,c,sname,salc,ssmo:string;   
  alc_level,smk_level,a,b,r,v,i:integer; 
  
procedure add_alc(var list:Pman; p:Pman);  
var 
  iterator:Pman;
begin
  if list=nil then 
    list:=p 
  else
    begin
    iterator:=list;
    while iterator^.next_alc<>nil do
      iterator:=iterator^.next_alc;
    iterator^.next_alc:=p;  
    end;
end;
  
procedure add_smoke(var list:Pman; p:Pman);  
var 
  iterator:Pman;
begin
  if list=nil then 
    list:=p
  else begin
    iterator:=list;
    while iterator^.next_smoke<>nil do
      iterator:=iterator^.next_smoke;
    iterator^.next_smoke:=p;  
  end;
end;
  
procedure print_man(p:Pman);  
begin
  writeln();
  write(p^.name);
  writeln;
  case p^.alc_level of
  1:write('не пьет');
  2:write('слабо пьет');
  3:write('сильно пьет');
  end;
  writeln;
  case p^.smoke_level of 
  1:write('не курит');
  2:write('слабо курит');
  3:write('сильно курит');
  end;
  writeln;
  writeln('====================================================================');
end;  
  
procedure add(name:string;a,b:integer);
var 
  i:integer;
  tmp:Pman;
begin
  
    new(tmp);
    tmp^.name:=name;
    tmp^.alc_level:=a;
    tmp^.smoke_level:=b;
    tmp^.shown:=false;
    tmp^.next_alc:=nil;
    tmp^.next_smoke:=nil;
    add_alc(alc[tmp^.alc_level],tmp);
    add_smoke(smoke[tmp^.smoke_level],tmp);
    
  
end;  

procedure search(list:Pman; alc_l,smo_l:integer);
begin
  if (list<>nil) and not(list^.shown) then begin
    list^.shown:=true;
    if (list^.alc_level=alc_l) and (list^.smoke_level=smo_l) then
      print_man(list);
    if list^.alc_level=alc_l then
      search(list^.next_alc,alc_l,smo_l);
    if list^.smoke_level=smo_l then 
      search(list^.next_smoke,alc_l,smo_l);
  end;
end;

begin
     writeln('Вызвать справку?');
     readln(s);
     if s='Да' then 
     begin writeln('1-не пьет/не курит');
     writeln('2-средняя степень алкоголизма/курения');
     writeln('3-высокая степень алкоголизма/курения');
     writeln;
     end;
     writeln('Для добавления пациента введите "NAME Alcohol(1/2/3) Smoking(1/2/3)" ');
     writeln('Для завершения ввода введите "END" ');

     readln(s);
     while (s <> 'END') do
     begin
       i := 1;
       while (s[i] <> ' ') and (i < length(s)) do
         inc(i);
       sname := copy(s, 1, i-1);
       salc := copy(s, i+1, 1);
       ssmo := copy(s, i+3, 1);
       val(salc,a,r);
       val(ssmo,b,v);
       add(sname,a,b);
       readln(s);
     end;
  writeln('====================================================================');
  writeln('Введите запрос в формате "Alcohol(1/2/3) Smoking(1/2/3)"');
  readln(s);
  while s<>'END' do
  begin

  c:=s.Split(' ')[0];
  if c = '1' then alc_level:=1;
  if c = '2' then alc_level:=2;
  if c = '3' then alc_level:=3;
  
  
  c:=s.Split(' ')[1];
  if c = '1' then smk_level:=1;
  if c = '2' then smk_level:=2;
  if c = '3' then smk_level:=3;
  
  search(alc[alc_level],alc_level,smk_level);
  search(smoke[smk_level],alc_level,smk_level);
  readln(s);
  end;
  
end.

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[min@y™]

Подскажите пожалуйста почему выходит за рамки массива?

Начинаем конкурс "угадай, в какой строке у автора ошибка"!
Битва экстрасенсов, блин...

И, таки да, типа, вот.

[Serge_Bliznykov]

Подскажите пожалуйста почему выходит за рамки массива?

формально ответ на ваш вопрос - Вы не проверяете введённую строку на наличие нужных данных:
вместо

while s<>'END' do
  begin

  c:=s.Split(' ')[0];
  if c = '1' then alc_level:=1;
  if c = '2' then alc_level:=2;
  if c = '3' then alc_level:=3;
  
  
  c:=s.Split(' ')[1];
  if c = '1' then smk_level:=1;
  if c = '2' then smk_level:=2;
  if c = '3' then smk_level:=3;
  
  search(alc[alc_level],alc_level,smk_level);
  search(smoke[smk_level],alc_level,smk_level);
  readln(s);
  end;

нужно написать с проверкой:

var
 ...
alc_level,smk_level,a,b,r,v,i,r1,r2:integer; 


while s<>'END' do
  begin
    var q := s.Split(' ');
    if Length(q)<2 then WriteLn('Ошибочный запрос. Введите запрос в формате 2х целых значений "Alcohol(1/2/3) Smoking(1/2/3)"')
    else begin
        val(q[0],alc_level,r1);
        val(q[1],smk_level,r2);
        if r1<>0 then WriteLn('Ошибочный запрос. первое значение должно быть число 1, 2 или 3 ');
        if r2<>0 then WriteLn('Ошибочный запрос. второе значение должно быть число 1, 2 или 3 ');
        if (r1=0) and (r2=0) then begin
           search(alc[alc_level],alc_level,smk_level);
           search(smoke[smk_level],alc_level,smk_level);
        end;
     end;   
     readln(s);
  end;