paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-25 20:49:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

* extended test

Browse Source 
git-svn-id: trunk@8192 -
This commit is contained in:
Jonas Maebe 2007-07-29 15:59:17 +00:00
parent 4b8777eb5a
commit caec7ab689
1 changed files with 41 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
tests/test/opt/tretopt.pp
View File

@ -14,14 +14,20 @@ type
end; end;
var var
p: pointer; p,p2: pointer;
failed: boolean;
procedure error(err: longint);
begin
writeln('error near ',err);
failed:=true;
end;
function f1(p: pchar): tr; function f1(p: pchar): tr;
begin begin
fillchar(result,sizeof(tr),0); fillchar(result,sizeof(tr),0);
if (p^<>'x') then if (p^<>'x') then
halt(1); error(1);
f1.a:=p^; f1.a:=p^;
end; end;
@ -30,7 +36,7 @@ function f2(var s: shortstring): tr;
begin begin
fillchar(result,sizeof(tr),0); fillchar(result,sizeof(tr),0);
if (s<>'x') then if (s<>'x') then
halt(2); error(2);
f2.a:=s; f2.a:=s;
end; end;
@ -39,7 +45,7 @@ function f3(const s: shortstring): tr;
begin begin
fillchar(result,sizeof(tr),0); fillchar(result,sizeof(tr),0);
if (s<>'x') then if (s<>'x') then
halt(3); error(3);
f3.a:=s; f3.a:=s;
end; end;
@ -48,7 +54,7 @@ function f4(const t: tr): tr;
begin begin
fillchar(result,sizeof(tr),0); fillchar(result,sizeof(tr),0);
if (t.a<>'x') then if (t.a<>'x') then
halt(4); error(4);
f4:=t; f4:=t;
end; end;
@ -58,7 +64,7 @@ function f5(p: pchar): ta;
begin begin
fillchar(result,sizeof(result),0); fillchar(result,sizeof(result),0);
if (p^<>'x') then if (p^<>'x') then
halt(5); error(5);
result[3]:=p^; result[3]:=p^;
end; end;
@ -67,7 +73,7 @@ function f6(var s: shortstring): ta;
begin begin
fillchar(result,sizeof(result),0); fillchar(result,sizeof(result),0);
if (s<>'x') then if (s<>'x') then
halt(6); error(6);
result[3]:=s; result[3]:=s;
end; end;
@ -76,7 +82,7 @@ function f7(const s: shortstring): ta;
begin begin
fillchar(result,sizeof(result),0); fillchar(result,sizeof(result),0);
if (s<>'x') then if (s<>'x') then
halt(7); error(7);
result[3]:=s; result[3]:=s;
end; end;
@ -85,7 +91,7 @@ function f8(const t: ta): ta;
begin begin
fillchar(result,sizeof(result),0); fillchar(result,sizeof(result),0);
if (t[3]<>'x') then if (t[3]<>'x') then
halt(8); error(8);
result:=t; result:=t;
end; end;
@ -93,7 +99,7 @@ end;
procedure temp; procedure temp;
begin begin
if (pshortstring(p)^<>'x') then if (pshortstring(p)^<>'x') then
halt(9); error(9);
end; end;
function f9: tr; function f9: tr;
@ -103,6 +109,19 @@ begin
result.a:='x'; result.a:='x';
end; end;
procedure temp2(var a);
begin
p2:=@a;
end;
function f10: tr;
begin
fillchar(result,sizeof(result),0);
if (pshortstring(p2)^<>'x') then
error(10);
result.a:='x';
end;
procedure testrec; procedure testrec;
var var
t: tr; t: tr;
@ -116,6 +135,15 @@ begin
t:=f9; t:=f9;
end; end;
procedure testrec2;
var
t: tr;
begin
t.a:='x';
temp2(t.a);
t:=f10;
end;
procedure testarr; procedure testarr;
var var
@ -130,5 +158,8 @@ end;
begin begin
testrec; testrec;
testrec2;
testarr; testarr;
if failed then
halt(1);
end. end.