From 6401bf9cad029c264ff65db946c8e31ce998db13 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Fran=C3=A7ois-Xavier=20Coudert?= Date: Wed, 14 May 2008 21:36:26 +0000 Subject: [PATCH] re PR fortran/36186 (Wrong handling of BOZ in CMPLX) 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 --- gcc/fortran/ChangeLog | 13 ++++++-- gcc/fortran/simplify.c | 48 ++++++++++++++++++++++------ gcc/testsuite/ChangeLog | 10 ++++-- gcc/testsuite/gfortran.dg/boz_11.f90 | 27 ++++++++++++++++ gcc/testsuite/gfortran.dg/boz_12.f90 | 14 ++++++++ 5 files changed, 98 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/boz_11.f90 create mode 100644 gcc/testsuite/gfortran.dg/boz_12.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2facb39a3f0..c38717cda56 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,8 +1,15 @@ +2008-05-14 Francois-Xavier Coudert + + 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 - 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 diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index e87804cef0c..066bf283767 100644 --- 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 1815f53c65a..9abe367154d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,13 @@ +2008-05-14 Francois-Xavier Coudert + + PR fortran/36186 + * gfortran.dg/boz_11.f90: New test. + * gfortran.dg/boz_12.f90: New test. + 2008-05-14 Paul Thomas - 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 diff --git a/gcc/testsuite/gfortran.dg/boz_11.f90 b/gcc/testsuite/gfortran.dg/boz_11.f90 new file mode 100644 index 00000000000..2bbf0221995 --- /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 index 00000000000..4c5c750d594 --- /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 -- 2.30.2