опубликован 09-02-2002 13:52 MSK            

---

program TestProg;
begin
writeln('Тестовая программа на Паскале.');
end.

;-D

опубликован 11-02-2002 01:46 MSK            

---

а таких есть в SWAGе...
А если сюды бухнуть... Хе-хе...

Program Test(input,output);
Type
StringsList=record {Strings with questions and answers}
s:string;
p,n:pointer;{list element pointers}
end;
pStringsList=^StringsList;
Answer=record{Answers list}
points:integer;
as:pStringsList;
p,n:pointer;
end;
pAnswer=^Answer;
Form=record
q:pStringsList;
a:pAnswer;
timeout:integer;{well... it must be, but Pascal have not standard time functions}
n,p:pointer;
end;
pForm=^Form;
Var
rs:string;{operation string}
f:Text;{file}
l:pForm;{Forms list pointer}
p:pointer;{operation pointer}
errorstate:integer;{runtime error flag}
PointsSum:longint;{gained points}
TotalPoints:longint;{points to pass the test}
res:integer;{any results}
Procedure Error(reason:string);
begin
Writeln('Error: ',reason);
Errorstate:=length(reason);{can be used to analyse reason}
end;
procedure ShowQuestion(qn:pForm);
var
pt:pStringsList;
pa:pAnswer;
num:Integer;{question number}
a:Integer;{answer number}
begin
if qn=nil then Error('Can''t ask nil question!')
else
begin
num:=0;
pt:=qn^.q;
while pt^.p<>nil do pt:=pt^.p;{set pointer to first string in list}
while pt<>nil do
begin
WriteLn(pt^.s);{Question string}
pt:=pt^.n;{next string, if present}
end;
pa:=qn^.a;
while pa^.p<>nil do pa:=pa^.p;{set pointer to first answer in list}
while pa<>nil do
begin
Num:=Num+1;
Write(Num,'. ');{Question number}
pt:=pa^.as;
while pt^.p<>nil do pt:=pt^.p;{set pointer to first string in list}
while pt<>nil do
begin
WriteLn(pt^.s);{Answer string}
pt:=pt^.n;{next string, if present}
end;
pa:=pa^.n;{next question}
end;
Repeat
Write('Type answer number and press Enter');
ReadLn(a);
Until (a>0) and (a<=Num);{only possible numbers}
pa:=qn^.a;
while pa^.p<>nil do pa:=pa^.p;{set pointer to first answer in list}
Num:=1;
While Num<>a do
begin
pa:=pa^.n;{set pointer to answer to check it}
Num:=Num+1;
end;
PointsSum:=PointsSum+pa^.points;{adding points}
if pa^.points=0 then WriteLn('Wrong answer')
else WriteLn('You gained ',PointsSum,' points');
end;
end;{Show question}
begin{Main procedure}
res:=0;
errorstate:=0;
pointsSum:=0;
TotalPoints:=0;
l:=nil;{No questions, no answers...}
p:=nil;{operating pointer}
Assign(f,'test.txt');
Reset(f);
while (not eof(f)) and (ErrorState=0) do
begin
Readln(f,rs);
if Length(rs)>2 then
begin
if Pos('Q?',rs)=1 then
begin
if l<>nil then ShowQuestion(l);{Show already parsed question}
p:=New(pForm);
if p=nil then Error('No memory for form!')
else
begin
if l<>nil then l^.n:=p;
pForm(p)^.p:=l;
l:=p;{New form in list}
l^.timeout:=0;{not implemented}
p:=New(pStringsList);{NewQuestion}
if p=nil then Error('No memory for question!')
else
begin
l^.q:=p;
pStringsList(p)^.p:=nil;
pStringsList(p)^.n:=nil;
pStringsList(p)^.s:=Copy(rs,3,Length(rs)-2);{cutting header}
end;
l^.a:=nil;{answers will be later}
end;
end{of question header}
else
if Pos('A?',rs)=1 then
begin
p:=New(pAnswer);
if p=nil then Error('No memory for answers!')
else
begin
pAnswer(p)^.n:=nil;
pAnswer(p)^.p:=l^.a;
if l^.a<>nil then l^.a^.n:=p;
l^.a:=p;{set questions pointer to new}
p:=New(pStringsList);{NewQuestion}
if p=nil then Error('No memory for question!')
else
begin
l^.a^.as:=p;
pStringsList(p)^.p:=nil;
pStringsList(p)^.n:=nil;
pStringsList(p)^.s:=Copy(rs,Pos(')',rs)+1,Length(rs)-Pos(')',rs));{cutting header}
rs:=Copy(rs,Pos('(',rs)+1,Pos(')',rs)-Pos('(',rs)-1);{cut number}
if rs='' then l^.a^.points:=0
else Val(rs,l^.a^.points,res);{or Read(rs,l^.a^.points) for standard Pascal}
if res<>0 then error('Incorrect number of points!');
end;
end;
end{of answer header}
else
if Pos('P?',rs)=1 then
begin
rs:=Copy(rs,Pos('(',rs)+1,Pos(')',rs)-Pos('(',rs)-1);{cut number}
if rs='' then TotalPoints:=0
else Val(rs,TotalPoints,res);{or Read(rs,Totalpoints) for standard Pascal}
if res<>0 then error('Incorrect number of total points!');
end{of total points header}
else
begin
pStringsList(p)^.n:=New(pStringsList);
if pStringsList(p)^.n=nil then Error('No memory for string')
else
begin
pStringsList(pStringsList(p)^.n)^.p:=p;{set pointers}
p:=pStringsList(p)^.n;
pStringsList(p)^.n:=nil;
pStringsList(p)^.s:=rs;{set string}
end;
end;{of strings list processing}
end;{of headers processing}
end;{of file reading loop}
if l<>nil then ShowQuestion(l);
WriteLn('Total points:',PointsSum);
If TotalPoints<=PointsSum then WriteLn('Test passed!')
else WriteLn('Test failed!');
end.