[PATCH] PR 16917: Add DFLOAT to gfortran

[Steve Kargl]

On Wed, Aug 11, 2004 at 12:13:06PM +0100, Paul Brook wrote:
> On Wednesday 11 August 2004 07:07, Steve Kargl wrote:
> > The attached patch adds support for DFLOAT to gfortran.  This
> > is required for compatibility with g77 and several other vendor's
> > f77 implementations (e.g, f2c and HP-UX).  This also fixes
> > PR 16917
> 
> ChangeLog? Testcase?

See below.  Note, I don't know the procedure for adding testcases
to the testsuite.  Do you just put a new file in the
gfortran.fortran-torture/execute and it is automatically found?
I've added a test case below, but you may need to tweak it.

> 
> Besides which patch looks wrong. You declare GFC_ISYM_DFLOAT, but don't use 
> it. gfc_simplify_dfloat is never used.

Whoops. Fixed.

> 
> Looks like you changed your mind half way through :)
> 

I didn't change my mind.  I started thinking about how 
I'm going to add j0, j0f, j1, j1f, y0, y0f, y1, and y1f
and completely forgot to double check the patch.

2004-08-11  Steven G. Kargl  <kargls@comcast.net>

        * check.c (gfc_check_dfloat): New function.
        * gfortran.h (GFC_ISYM_DFLOAT): New symbol.
        * intrinsic.c: Add DFLOAT to list of intrinsic functions.
        * intrinsic.h: Prototypes for gfc_check_dfloat and gfc_simplify_dfloat.
        * simplify.c (gfc_simplify_dfloat): New function.

2004-08-11  Steven G. Kargl  <kargls@comcast.net>
 
        * dfloat.f90: Test case for DFLOAT intrinsic.

-- 
Steve
-------------- next part --------------
? dfloat.f90
Index: check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.7
diff -u -b -u -r1.7 check.c
--- check.c	14 Jun 2004 15:56:48 -0000	1.7
+++ check.c	11 Aug 2004 15:17:45 -0000
@@ -638,6 +638,20 @@
 
 
 try
+gfc_check_dfloat (gfc_expr * x)
+{
+
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (x, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_digits (gfc_expr * x)
 {
 
Index: gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.21
diff -u -b -u -r1.21 gfortran.h
--- gfortran.h	8 Aug 2004 12:28:25 -0000	1.21
+++ gfortran.h	11 Aug 2004 15:17:47 -0000
@@ -297,6 +297,7 @@
   GFC_ISYM_COUNT,
   GFC_ISYM_CSHIFT,
   GFC_ISYM_DBLE,
+  GFC_ISYM_DFLOAT,
   GFC_ISYM_DIM,
   GFC_ISYM_DOT_PRODUCT,
   GFC_ISYM_DPROD,
Index: intrinsic.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.c,v
retrieving revision 1.14
diff -u -b -u -r1.14 intrinsic.c
--- intrinsic.c	6 Aug 2004 21:46:56 -0000	1.14
+++ intrinsic.c	11 Aug 2004 15:17:49 -0000
@@ -1050,6 +1050,12 @@
 
   make_generic ("dble", GFC_ISYM_DBLE);
 
+  add_sym_1 ("dfloat", 0, 1, BT_REAL, dd,
+	     gfc_check_dfloat, gfc_simplify_dfloat, NULL,
+	     x, BT_INTEGER, di, 0);
+
+  make_generic ("dfloat", GFC_ISYM_DFLOAT);
+
   add_sym_1 ("digits", 0, 1, BT_INTEGER, di,
 	     gfc_check_digits, gfc_simplify_digits, NULL,
 	     x, BT_UNKNOWN, dr, 0);
Index: intrinsic.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/intrinsic.h,v
retrieving revision 1.9
diff -u -b -u -r1.9 intrinsic.h
--- intrinsic.h	6 Aug 2004 21:46:56 -0000	1.9
+++ intrinsic.h	11 Aug 2004 15:17:50 -0000
@@ -41,6 +41,7 @@
 try gfc_check_cshift (gfc_expr *, gfc_expr *, gfc_expr *);
 try gfc_check_dcmplx (gfc_expr *, gfc_expr *);
 try gfc_check_dble (gfc_expr *);
+try gfc_check_dfloat (gfc_expr *);
 try gfc_check_digits (gfc_expr *);
 try gfc_check_dot_product (gfc_expr *, gfc_expr *);
 try gfc_check_eoshift (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *);
@@ -137,6 +138,7 @@
 gfc_expr *gfc_simplify_cosh (gfc_expr *);
 gfc_expr *gfc_simplify_dcmplx (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_dble (gfc_expr *);
+gfc_expr *gfc_simplify_dfloat (gfc_expr *);
 gfc_expr *gfc_simplify_digits (gfc_expr *);
 gfc_expr *gfc_simplify_dim (gfc_expr *, gfc_expr *);
 gfc_expr *gfc_simplify_dprod (gfc_expr *, gfc_expr *);
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.7
diff -u -b -u -r1.7 simplify.c
--- simplify.c	8 Aug 2004 12:28:25 -0000	1.7
+++ simplify.c	11 Aug 2004 15:17:53 -0000
@@ -814,6 +814,23 @@
 
 
 gfc_expr *
+gfc_simplify_dfloat (gfc_expr * e)
+{
+  gfc_expr *result;
+
+  if (e->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  if (e->ts.type == BT_INTEGER)
+    result = gfc_int2real (e, gfc_default_double_kind ());
+  else
+    gfc_internal_error ("gfc_simplify_dfloat(): bad type at %L", &e->where);
+
+  return range_check (result, "DFLOAT");
+}
+
+
+gfc_expr *
 gfc_simplify_digits (gfc_expr * x)
 {
   int i, digits;
-------------- next part --------------
program test_dfloat
   implicit none
   integer(2) i2
   integer(4) i4
   integer(8) i8
   i2 = -4_2
   i4 = 4_4
   i8 = 10_8
   if (dfloat(i2) /= -4.d0) call abort()
   if (dfloat(i4) /= 4.d0) call abort()
   if (dfloat(i8) /= 10.d0) call abort()
   if (dfloat(i4*i2) /= -16.d0) call abort()
end program test_dfloat