Browse Source

* extended test

git-svn-id: trunk@8192 -
Jonas Maebe 18 years ago
parent
commit
caec7ab689
1 changed files with 41 additions and 10 deletions
  1. 41 10
      tests/test/opt/tretopt.pp

+ 41 - 10
tests/test/opt/tretopt.pp

@@ -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.