Browse Source

* add code to remember that currency is only implemented in 1.1 compiler

pierre 23 years ago
parent
commit
39b2a66e7d

+ 47 - 35
tests/test/units/system/tabs.pp

@@ -2,6 +2,9 @@
 { Carl Eric Codere Copyright (c) 2002 }
 { Carl Eric Codere Copyright (c) 2002 }
 program tabs;
 program tabs;
 
 
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
 {$APPTYPE CONSOLE}
 {$APPTYPE CONSOLE}
 {$R+}
 {$R+}
 {$Q+}
 {$Q+}
@@ -13,14 +16,14 @@ const
   RESULT_TWO_INT = 12345;
   RESULT_TWO_INT = 12345;
   VALUE_TWO_INT = 12345;
   VALUE_TWO_INT = 12345;
   RESULT_CONST_TWO_INT = abs(VALUE_TWO_INT);
   RESULT_CONST_TWO_INT = abs(VALUE_TWO_INT);
-  
+
   RESULT_THREE_INT = 2147483647;
   RESULT_THREE_INT = 2147483647;
   VALUE_THREE_INT = -2147483647;
   VALUE_THREE_INT = -2147483647;
   RESULT_CONST_THREE_INT = abs(VALUE_THREE_INT);
   RESULT_CONST_THREE_INT = abs(VALUE_THREE_INT);
   RESULT_FOUR_INT = 2147483647;
   RESULT_FOUR_INT = 2147483647;
   VALUE_FOUR_INT = 2147483647;
   VALUE_FOUR_INT = 2147483647;
   RESULT_CONST_FOUR_INT = abs(VALUE_FOUR_INT);
   RESULT_CONST_FOUR_INT = abs(VALUE_FOUR_INT);
-  
+
 
 
   RESULT_ONE_REAL = 12345.6789;
   RESULT_ONE_REAL = 12345.6789;
   VALUE_ONE_REAL = -12345.6789;
   VALUE_ONE_REAL = -12345.6789;
@@ -28,7 +31,7 @@ const
   RESULT_TWO_REAL = 54321.6789E+02;
   RESULT_TWO_REAL = 54321.6789E+02;
   VALUE_TWO_REAL = 54321.6789E+02;
   VALUE_TWO_REAL = 54321.6789E+02;
   RESULT_CONST_TWO_REAL = abs(VALUE_TWO_REAL);
   RESULT_CONST_TWO_REAL = abs(VALUE_TWO_REAL);
-  
+
   RESULT_THREE_REAL = 0.0;
   RESULT_THREE_REAL = 0.0;
   VALUE_THREE_REAL = 0.0;
   VALUE_THREE_REAL = 0.0;
   RESULT_CONST_THREE_REAL = abs(VALUE_THREE_REAL);
   RESULT_CONST_THREE_REAL = abs(VALUE_THREE_REAL);
@@ -36,14 +39,15 @@ const
   VALUE_FOUR_REAL = -12.0;
   VALUE_FOUR_REAL = -12.0;
   RESULT_CONST_FOUR_REAL = abs(VALUE_FOUR_REAL);
   RESULT_CONST_FOUR_REAL = abs(VALUE_FOUR_REAL);
 
 
- 
+
 procedure fail;
 procedure fail;
  begin
  begin
   WriteLn('Failure!');
   WriteLn('Failure!');
   halt(1);
   halt(1);
  end;
  end;
- 
 
 
+
+{$ifndef SKIP_CURRENCY_TEST}
  procedure test_abs_currency;
  procedure test_abs_currency;
   var
   var
    _result : boolean;
    _result : boolean;
@@ -52,11 +56,11 @@ procedure fail;
   begin
   begin
     Write('Abs() test with currency type...');
     Write('Abs() test with currency type...');
     _result := true;
     _result := true;
-    
+
     value := VALUE_ONE_REAL;
     value := VALUE_ONE_REAL;
     if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
     if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
        _result := false;
        _result := false;
-       
+
     value := VALUE_TWO_REAL;
     value := VALUE_TWO_REAL;
     if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
     if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
        _result := false;
        _result := false;
@@ -64,7 +68,7 @@ procedure fail;
     value := VALUE_THREE_REAL;
     value := VALUE_THREE_REAL;
     if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
     if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_REAL;
     value := VALUE_FOUR_REAL;
     if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
     if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
        _result := false;
        _result := false;
@@ -73,7 +77,7 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_ONE_REAL) then
     if trunc(value1) <> trunc(RESULT_ONE_REAL) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_TWO_REAL;
     value := VALUE_TWO_REAL;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_TWO_REAL) then
     if trunc(value1) <> trunc(RESULT_TWO_REAL) then
@@ -83,18 +87,19 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_THREE_REAL) then
     if trunc(value1) <> trunc(RESULT_THREE_REAL) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_REAL;
     value := VALUE_FOUR_REAL;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
     if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
        _result := false;
        _result := false;
 
 
-       
+
     if not _result then
     if not _result then
       fail
       fail
     else
     else
       WriteLn('Success!');
       WriteLn('Success!');
   end;
   end;
+{$endif SKIP_CURRENCY_TEST}
 
 
 
 
 
 
@@ -110,8 +115,8 @@ procedure fail;
    value := VALUE_ONE_INT;
    value := VALUE_ONE_INT;
     if (abs(value) <> (RESULT_CONST_ONE_INT))  then
     if (abs(value) <> (RESULT_CONST_ONE_INT))  then
        _result := false;
        _result := false;
-       
-       
+
+
     value := VALUE_TWO_INT;
     value := VALUE_TWO_INT;
     if abs(value) <> (RESULT_CONST_TWO_INT) then
     if abs(value) <> (RESULT_CONST_TWO_INT) then
        _result := false;
        _result := false;
@@ -119,7 +124,7 @@ procedure fail;
     value := VALUE_THREE_INT;
     value := VALUE_THREE_INT;
     if abs(value) <> (RESULT_CONST_THREE_INT) then
     if abs(value) <> (RESULT_CONST_THREE_INT) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_INT;
     value := VALUE_FOUR_INT;
     if abs(value) <> (RESULT_CONST_FOUR_INT) then
     if abs(value) <> (RESULT_CONST_FOUR_INT) then
        _result := false;
        _result := false;
@@ -128,7 +133,7 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_ONE_INT) then
     if value1 <> (RESULT_ONE_INT) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_TWO_INT;
     value := VALUE_TWO_INT;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_TWO_INT) then
     if value1 <> (RESULT_TWO_INT) then
@@ -138,19 +143,19 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_THREE_INT) then
     if value1 <> (RESULT_THREE_INT) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_INT;
     value := VALUE_FOUR_INT;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_FOUR_INT) then
     if value1 <> (RESULT_FOUR_INT) then
        _result := false;
        _result := false;
-    
+
     if not _result then
     if not _result then
       fail
       fail
     else
     else
       WriteLn('Success!');
       WriteLn('Success!');
   end;
   end;
 
 
-  
+
  procedure test_abs_longint;
  procedure test_abs_longint;
   var
   var
    _result : boolean;
    _result : boolean;
@@ -159,12 +164,12 @@ procedure fail;
   begin
   begin
     Write('Abs() test with longint type...');
     Write('Abs() test with longint type...');
     _result := true;
     _result := true;
-    
+
    value := VALUE_ONE_INT;
    value := VALUE_ONE_INT;
     if (abs(value) <> (RESULT_CONST_ONE_INT))  then
     if (abs(value) <> (RESULT_CONST_ONE_INT))  then
        _result := false;
        _result := false;
-       
-       
+
+
     value := VALUE_TWO_INT;
     value := VALUE_TWO_INT;
     if abs(value) <> (RESULT_CONST_TWO_INT) then
     if abs(value) <> (RESULT_CONST_TWO_INT) then
        _result := false;
        _result := false;
@@ -172,7 +177,7 @@ procedure fail;
     value := VALUE_THREE_INT;
     value := VALUE_THREE_INT;
     if abs(value) <> (RESULT_CONST_THREE_INT) then
     if abs(value) <> (RESULT_CONST_THREE_INT) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_INT;
     value := VALUE_FOUR_INT;
     if abs(value) <> (RESULT_CONST_FOUR_INT) then
     if abs(value) <> (RESULT_CONST_FOUR_INT) then
        _result := false;
        _result := false;
@@ -181,7 +186,7 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_ONE_INT) then
     if value1 <> (RESULT_ONE_INT) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_TWO_INT;
     value := VALUE_TWO_INT;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_TWO_INT) then
     if value1 <> (RESULT_TWO_INT) then
@@ -191,19 +196,19 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_THREE_INT) then
     if value1 <> (RESULT_THREE_INT) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_INT;
     value := VALUE_FOUR_INT;
     value1 := abs(value);
     value1 := abs(value);
     if value1 <> (RESULT_FOUR_INT) then
     if value1 <> (RESULT_FOUR_INT) then
        _result := false;
        _result := false;
-    
+
     if not _result then
     if not _result then
       fail
       fail
     else
     else
       WriteLn('Success!');
       WriteLn('Success!');
   end;
   end;
-  
- procedure test_abs_real; 
+
+ procedure test_abs_real;
   var
   var
    _result : boolean;
    _result : boolean;
    value : real;
    value : real;
@@ -211,11 +216,11 @@ procedure fail;
   begin
   begin
     _result := true;
     _result := true;
     Write('Abs() test with real type...');
     Write('Abs() test with real type...');
-    
+
     value := VALUE_ONE_REAL;
     value := VALUE_ONE_REAL;
     if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
     if (trunc(abs(value)) <> trunc(RESULT_CONST_ONE_REAL))  then
        _result := false;
        _result := false;
-       
+
     value := VALUE_TWO_REAL;
     value := VALUE_TWO_REAL;
     if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
     if trunc(abs(value)) <> trunc(RESULT_CONST_TWO_REAL) then
        _result := false;
        _result := false;
@@ -223,7 +228,7 @@ procedure fail;
     value := VALUE_THREE_REAL;
     value := VALUE_THREE_REAL;
     if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
     if trunc(abs(value)) <> trunc(RESULT_CONST_THREE_REAL) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_REAL;
     value := VALUE_FOUR_REAL;
     if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
     if trunc(abs(value)) <> trunc(RESULT_CONST_FOUR_REAL) then
        _result := false;
        _result := false;
@@ -232,7 +237,7 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_ONE_REAL) then
     if trunc(value1) <> trunc(RESULT_ONE_REAL) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_TWO_REAL;
     value := VALUE_TWO_REAL;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_TWO_REAL) then
     if trunc(value1) <> trunc(RESULT_TWO_REAL) then
@@ -242,12 +247,12 @@ procedure fail;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_THREE_REAL) then
     if trunc(value1) <> trunc(RESULT_THREE_REAL) then
        _result := false;
        _result := false;
-       
+
     value := VALUE_FOUR_REAL;
     value := VALUE_FOUR_REAL;
     value1 := abs(value);
     value1 := abs(value);
     if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
     if trunc(value1) <> trunc(RESULT_FOUR_REAL) then
        _result := false;
        _result := false;
-    
+
     if not _result then
     if not _result then
       fail
       fail
     else
     else
@@ -259,7 +264,11 @@ var
  _success : boolean;
  _success : boolean;
  l: boolean;
  l: boolean;
 Begin
 Begin
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
   test_abs_currency;
   test_abs_currency;
+{$endif SKIP_CURRENCY_TEST}
   test_abs_real;
   test_abs_real;
   test_abs_longint;
   test_abs_longint;
   test_abs_int64;
   test_abs_int64;
@@ -267,8 +276,11 @@ end.
 
 
 {
 {
  $Log$
  $Log$
- Revision 1.1  2002-09-18 18:30:30  carl
+ Revision 1.2  2002-10-15 10:26:36  pierre
+  * add code to remember that currency is only implemented in 1.1 compiler
+
+ Revision 1.1  2002/09/18 18:30:30  carl
    + currency testing
    + currency testing
    * more system unit routine testing
    * more system unit routine testing
 
 
-} 
+}

+ 14 - 1
tests/test/units/system/tint.pp

@@ -3,6 +3,10 @@
   just like in Delphi }
   just like in Delphi }
 program tint;
 program tint;
 
 
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
+
 const
 const
   INT_RESULT_ONE = 1234;
   INT_RESULT_ONE = 1234;
   INT_VALUE_ONE = 1234.5678;
   INT_VALUE_ONE = 1234.5678;
@@ -156,6 +160,7 @@ Begin
  WriteLn('Success!');
  WriteLn('Success!');
 end;
 end;
 
 
+{$ifndef SKIP_CURRENCY_TEST}
 procedure test_int_currency;
 procedure test_int_currency;
 var
 var
  r: currency;
  r: currency;
@@ -201,17 +206,25 @@ Begin
    fail;
    fail;
  WriteLn('Success!');
  WriteLn('Success!');
 end;
 end;
+{$endif SKIP_CURRENCY_TEST}
 
 
 Begin
 Begin
   test_int_real;
   test_int_real;
   test_int_double;
   test_int_double;
   test_int_single;
   test_int_single;
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
   test_int_currency;
   test_int_currency;
+{$endif SKIP_CURRENCY_TEST}
 end.
 end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2002-09-18 18:30:30  carl
+  Revision 1.3  2002-10-15 10:26:36  pierre
+   * add code to remember that currency is only implemented in 1.1 compiler
+
+  Revision 1.2  2002/09/18 18:30:30  carl
     + currency testing
     + currency testing
     * more system unit routine testing
     * more system unit routine testing
 
 

+ 14 - 2
tests/test/units/system/tround.pp

@@ -1,6 +1,10 @@
 { this tests the round routine }
 { this tests the round routine }
 program tround;
 program tround;
 
 
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
+
 {$APPTYPE CONSOLE}
 {$APPTYPE CONSOLE}
 
 
 const
 const
@@ -160,7 +164,7 @@ Begin
  WriteLn('Success!');
  WriteLn('Success!');
 end;
 end;
 
 
-
+{$ifndef SKIP_CURRENCY_TEST}
 procedure test_round_currency;
 procedure test_round_currency;
 var
 var
  r: currency;
  r: currency;
@@ -207,6 +211,7 @@ Begin
    fail;
    fail;
  WriteLn('Success!');
  WriteLn('Success!');
 end;
 end;
+{$endif SKIP_CURRENCY_TEST}
 
 
 
 
 
 
@@ -215,12 +220,19 @@ Begin
   test_round_real;
   test_round_real;
   test_round_single;
   test_round_single;
   test_round_double;
   test_round_double;
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
   test_round_currency;
   test_round_currency;
+{$endif SKIP_CURRENCY_TEST}
 end.
 end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2002-09-18 18:30:30  carl
+  Revision 1.3  2002-10-15 10:26:36  pierre
+   * add code to remember that currency is only implemented in 1.1 compiler
+
+  Revision 1.2  2002/09/18 18:30:30  carl
     + currency testing
     + currency testing
     * more system unit routine testing
     * more system unit routine testing
 
 

+ 14 - 1
tests/test/units/system/ttrunc.pp

@@ -1,6 +1,10 @@
 { this tests the trunc routine }
 { this tests the trunc routine }
 program ttrunc;
 program ttrunc;
 
 
+{$ifdef VER1_0}
+  {$define SKIP_CURRENCY_TEST}
+{$endif }
+
 {$APPTYPE CONSOLE}
 {$APPTYPE CONSOLE}
 
 
 const
 const
@@ -161,6 +165,7 @@ Begin
 end;
 end;
 
 
 
 
+{$ifndef SKIP_CURRENCY_TEST}
 procedure test_trunc_currency;
 procedure test_trunc_currency;
 var
 var
  r: currency;
  r: currency;
@@ -207,18 +212,26 @@ Begin
    fail;
    fail;
  WriteLn('Success!');
  WriteLn('Success!');
 end;
 end;
+{$endif SKIP_CURRENCY_TEST}
 
 
 
 
 Begin
 Begin
   test_trunc_real;
   test_trunc_real;
   test_trunc_single;
   test_trunc_single;
   test_trunc_double;
   test_trunc_double;
+{$ifdef SKIP_CURRENCY_TEST}
+  Writeln('Skipping currency test because its not supported by theis compiler');
+{$else SKIP_CURRENCY_TEST}
   test_trunc_currency;
   test_trunc_currency;
+{$endif SKIP_CURRENCY_TEST}
 end.
 end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2002-09-18 18:30:30  carl
+  Revision 1.3  2002-10-15 10:26:36  pierre
+   * add code to remember that currency is only implemented in 1.1 compiler
+
+  Revision 1.2  2002/09/18 18:30:30  carl
     + currency testing
     + currency testing
     * more system unit routine testing
     * more system unit routine testing