From 802fa8ed32de96e5b3987b23430ff8930c3edda4 Mon Sep 17 00:00:00 2001
From: tom_at_work <tom_at_work@idefix.freepascal.org>
Date: Sun, 4 Jun 2006 12:37:26 +0000
Subject: [PATCH] + new additional test program for testing record register
 variables

git-svn-id: trunk@3786 -
---
 .gitattributes         |  1 +
 tests/test/trecreg3.pp | 88 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 89 insertions(+)
 create mode 100644 tests/test/trecreg3.pp

diff --git a/.gitattributes b/.gitattributes
index b8d14191ac..2aa804c472 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -6103,6 +6103,7 @@ tests/test/trange5.pp svneol=native#text/plain
 tests/test/trangeob.pp svneol=native#text/plain
 tests/test/trecreg.pp -text
 tests/test/trecreg2.pp svneol=native#text/plain
+tests/test/trecreg3.pp -text
 tests/test/tresstr.pp svneol=native#text/plain
 tests/test/trtti1.pp svneol=native#text/plain
 tests/test/trtti2.pp svneol=native#text/plain
diff --git a/tests/test/trecreg3.pp b/tests/test/trecreg3.pp
new file mode 100644
index 0000000000..a22aa2fa8d
--- /dev/null
+++ b/tests/test/trecreg3.pp
@@ -0,0 +1,88 @@
+{$mode delphi}
+const
+  RS_CR0 = 1;
+  RS_CR1 = 2;
+  RS_CR2 = 3;
+  RS_CR3 = 4;
+  RS_CR4 = 5;
+  RS_CR5 = 6;
+  RS_CR6 = 7;
+  RS_CR7 = 8;
+type
+  TResFlagsEnum = (F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX,
+    F_OX);
+  TResFlags = record
+    cr: RS_CR0..RS_CR7;
+    flag: TResFlagsEnum;
+  end;
+
+type
+  TAsmCondFlag = (C_None { unconditional jumps },
+    { conditions when not using ctr decrement etc }
+    C_LT, C_LE, C_EQ, C_GE, C_GT, C_NL, C_NE, C_NG, C_SO, C_NS, C_UN, C_NU,
+    { conditions when using ctr decrement etc }
+    C_T, C_F, C_DNZ, C_DNZT, C_DNZF, C_DZ, C_DZT, C_DZF);
+
+  TDirHint = (DH_None, DH_Minus, DH_Plus);
+
+const
+  { these are in the XER, but when moved to CR_x they correspond with the }
+  { bits below                                                            }
+  C_OV = C_GT;
+  C_CA = C_EQ;
+  C_NO = C_NG;
+  C_NC = C_NE;
+
+
+type
+  TAsmCond = packed record
+    dirhint: tdirhint;
+    case simple: boolean of
+      false: (BO, BI: byte);
+      true: (
+        cond: TAsmCondFlag;
+        case byte of
+          0: ();
+          { specifies in which part of the cr the bit has to be }
+          { tested for blt,bgt,beq,..,bnu                       }
+          1: (cr: RS_CR0..RS_CR7);
+          { specifies the bit to test for bt,bf,bdz,..,bdzf }
+          2: (crbit: byte)
+          );
+  end;
+
+procedure error(err : int64);
+begin
+  writeln('Error: ', err);
+  halt(1);
+end;
+
+
+function flags_to_cond(const f: TResFlags): TAsmCond;
+const
+  flag_2_cond: array[F_EQ..F_SO] of TAsmCondFlag =
+  (C_EQ, C_NE, C_LT, C_LE, C_GT, C_GE, C_SO);
+begin
+  if f.flag > high(flag_2_cond) then
+    error(1);
+  case f.flag of
+    F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX,
+    F_OX:
+      ;
+  else
+    error(2);
+  end;
+  result.simple := true;
+  result.cr := f.cr;
+  result.cond := flag_2_cond[f.flag];
+end;
+
+var flags : TResFlags;
+begin
+   flags.cr := RS_CR7;
+   flags.flag := F_EQ;
+   flags_to_cond(flags);  
+   writeln('Passed');
+end.
+
+