PR fortran/36186

	* simplify.c (only_convert_cmplx_boz): New function.
	(gfc_simplify_cmplx, gfc_simplify_complex, gfc_simplify_dcmplx):
	Call only_convert_cmplx_boz.

	* gfortran.dg/boz_11.f90: New test.
	* gfortran.dg/boz_12.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@135308 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2facb39..c38717c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,8 +1,15 @@
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/36186
+       * simplify.c (only_convert_cmplx_boz): New function.
+       (gfc_simplify_cmplx, gfc_simplify_complex, gfc_simplify_dcmplx):
+       Call only_convert_cmplx_boz.
+
 2008-05-14  Paul Thomas  <pault@gcc.gnu.org>
 
-       PR fortran/36233
-       * interface.c (compare_actual_formal): Do not check sizes if the
-       actual is BT_PROCEDURE.
+       PR fortran/36233
+       * interface.c (compare_actual_formal): Do not check sizes if the
+       actual is BT_PROCEDURE.
 
 2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index e87804c..066bf28 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -928,19 +928,49 @@ simplify_cmplx (const char *name, gfc_expr *x, gfc_expr *y, int kind)
 }
 
 
+/* Function called when we won't simplify an expression like CMPLX (or
+   COMPLEX or DCMPLX) but still want to convert BOZ arguments.  */
+
+static gfc_expr *
+only_convert_cmplx_boz (gfc_expr *x, gfc_expr *y, int kind)
+{
+  if (x->is_boz)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+      ts.type = BT_REAL;
+      ts.kind = kind;
+      if (!gfc_convert_boz (x, &ts))
+       return &gfc_bad_expr;
+    }
+
+  if (y && y->is_boz)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+      ts.type = BT_REAL;
+      ts.kind = kind;
+      if (!gfc_convert_boz (y, &ts))
+       return &gfc_bad_expr;
+    }
+
+  return NULL;
+}
+
+
 gfc_expr *
 gfc_simplify_cmplx (gfc_expr *x, gfc_expr *y, gfc_expr *k)
 {
   int kind;
 
-  if (x->expr_type != EXPR_CONSTANT
-      || (y != NULL && y->expr_type != EXPR_CONSTANT))
-    return NULL;
-
   kind = get_kind (BT_REAL, k, "CMPLX", gfc_default_real_kind);
   if (kind == -1)
     return &gfc_bad_expr;
 
+  if (x->expr_type != EXPR_CONSTANT
+      || (y != NULL && y->expr_type != EXPR_CONSTANT))
+    return only_convert_cmplx_boz (x, y, kind);
+
   return simplify_cmplx ("CMPLX", x, y, kind);
 }
 
@@ -950,10 +980,6 @@ gfc_simplify_complex (gfc_expr *x, gfc_expr *y)
 {
   int kind;
 
-  if (x->expr_type != EXPR_CONSTANT
-      || (y != NULL && y->expr_type != EXPR_CONSTANT))
-    return NULL;
-
   if (x->ts.type == BT_INTEGER)
     {
       if (y->ts.type == BT_INTEGER)
@@ -969,6 +995,10 @@ gfc_simplify_complex (gfc_expr *x, gfc_expr *y)
        kind = x->ts.kind;
     }
 
+  if (x->expr_type != EXPR_CONSTANT
+      || (y != NULL && y->expr_type != EXPR_CONSTANT))
+    return only_convert_cmplx_boz (x, y, kind);
+
   return simplify_cmplx ("COMPLEX", x, y, kind);
 }
 
@@ -1052,7 +1082,7 @@ gfc_simplify_dcmplx (gfc_expr *x, gfc_expr *y)
 
   if (x->expr_type != EXPR_CONSTANT
       || (y != NULL && y->expr_type != EXPR_CONSTANT))
-    return NULL;
+    return only_convert_cmplx_boz (x, y, gfc_default_double_kind);
 
   return simplify_cmplx ("DCMPLX", x, y, gfc_default_double_kind);
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1815f53..9abe367 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,7 +1,13 @@
+2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/36186
+       * gfortran.dg/boz_11.f90: New test.
+       * gfortran.dg/boz_12.f90: New test.
+
 2008-05-14  Paul Thomas  <pault@gcc.gnu.org>
 
-       PR fortran/36233
-       * gfortran.dg/actual_procedure_1.f90: New test
+       PR fortran/36233
+       * gfortran.dg/actual_procedure_1.f90: New test
 
 2008-05-14  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 

diff --git a/gcc/testsuite/gfortran.dg/boz_11.f90 b/gcc/testsuite/gfortran.dg/boz_11.f90
new file mode 100644 (file)
index 0000000..2bbf022
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_11.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+program test0
+   implicit none
+   real, parameter :: &
+     r = transfer(int(b'01000000001010010101001111111101',kind=4),0.)
+   complex, parameter :: z = r * (0, 1.)
+   real(kind=8), parameter :: rd = dble(b'00000000000000000000000000000000&
+                                         &01000000001010010101001111111101')
+   complex(kind=8), parameter :: zd = (0._8, 1._8) * rd
+   integer :: x = 0
+
+   if (cmplx(b'01000000001010010101001111111101',x,4) /= r) call abort
+   if (cmplx(x,b'01000000001010010101001111111101',4) /= z) call abort
+   if (complex(b'01000000001010010101001111111101',0) /= r) call abort
+   if (complex(0,b'01000000001010010101001111111101') /= z) call abort
+
+   !if (cmplx(b'00000000000000000000000000000000&
+   !           &01000000001010010101001111111101',x,8) /= rd) call abort
+   !if (cmplx(x,b'00000000000000000000000000000000&
+   !             &01000000001010010101001111111101',8) /= zd) call abort
+   !if (dcmplx(b'00000000000000000000000000000000&
+   !            &01000000001010010101001111111101',x) /= rd) call abort
+   !if (dcmplx(x,b'00000000000000000000000000000000&
+   !              &01000000001010010101001111111101') /= zd) call abort
+
+end program test0

diff --git a/gcc/testsuite/gfortran.dg/boz_12.f90 b/gcc/testsuite/gfortran.dg/boz_12.f90
new file mode 100644 (file)
index 0000000..4c5c750
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/boz_12.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! 
+program test
+  implicit none
+  real x4
+  double precision x8
+
+  x4 = 1.7
+  x8 = 1.7
+  write(*,*) complex(x4,z'1FFFFFFFF') ! { dg-error "too" }
+  write(*,*) cmplx(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+  write(*,*) complex(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+  write(*,*) dcmplx(x8,z'1FFFFFFFFFFFFFFFF') ! { dg-error "too" }
+end program test