mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-21 23:00:52 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/36186 (Wrong handling of BOZ in CMPLX)

Browse Source 
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.

From-SVN: r135308
This commit is contained in:
François-Xavier Coudert 2008-05-14 21:36:26 +00:00
parent 16f2a7a4a5
commit 6401bf9cad
5 changed files with 98 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -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>

48
gcc/fortran/simplify.c
View File

@ -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);
}

10
gcc/testsuite/ChangeLog
View File

@ -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>

27
gcc/testsuite/gfortran.dg/boz_11.f90 Normal file
View File

@ -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

14
gcc/testsuite/gfortran.dg/boz_12.f90 Normal file
View File

@ -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