a68: fix float standard conversion routine

This commit fixes the implementation of the `float' standard
conversion routine, by amending a typo that originates in the Revised
Report.  It also makes the routine to properly handle short short and
short int arguments.

Signed-off-by: Jose E. Marchesi <jemarch@gnu.org
libga68/ChangeLog

	* standard.a68.in (float): Fix typo from RR and handle short* int
	arguments properly.

gcc/testsuite/ChangeLog

	* algol68/execute/float-1.a68: New test.

diff --git a/gcc/testsuite/algol68/execute/float-1.a68 b/gcc/testsuite/algol68/execute/float-1.a68
new file mode 100644 (file)
index 0000000..1c3531b
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/float-1.a68
@@ -0,0 +1,3 @@
+begin assert(float(123.4567,12,5,2) = "+12.34567e+1");
+      assert(float(123.4567,-10,5,-1) = " 1.23457e2")
+end

diff --git a/libga68/standard.a68.in b/libga68/standard.a68.in
index 6d543e7cff86048381b5bb03933df3bf94321e0d..5246679fa9f6e1ad6c7ec2e3669f0d172248e081 100644 (file)
--- a/libga68/standard.a68.in
+++ b/libga68/standard.a68.in
@@ -114,21 +114,26 @@ def
         case v in
            {iter L  {} {long}  {long long}}
            {iter L_ {} {long_} {long_long_}}
+           {iter S  {} {LENG}  {LENG LENG}}
            ({L} real x):
               if int before = ABS width - ABS exp - (after /= 0 | after+1 | 0) - 2;
                  SIGN before + SIGN after > 0
               then string s, {L} real y := ABS x, int p := 0;
                    {L_}standardize (y, before, after, p);
-                   s := fixed (SIGN (x * y), SIGN width * (ABS width - ABS exp - 1),
-                               after) + "*^" + whole (p, exp);
+                   s := fixed ({S} SIGN x * y, SIGN width * (ABS width - ABS exp - 1),
+                               after) + "e" + whole (p, exp);
                    if exp = 0 OR char_in_string (errorchar, loc int, s)
                    then float (x, width, (after /= 0 | after-1 | 0),
                                (exp > 0 | exp+1 | exp-1))
                    else s
                    fi
               else { XXX undefined } skip; ABS width * errorchar
-              fi,
-           ({L} int x): float ({L} real (x), width, after, exp)
+              fi
+           {reti {,}}
+           ,
+           {iter L {short short} {short} {} {long} {long long}}
+           {iter R {LENG LENG} {LENG} {} {} {}}
+           ({L} int x): float ({L} real ({R} x), width, after, exp)
            {reti {,}}
         esac;