diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 23 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/array_function_2.f90 | 30 |
4 files changed, 61 insertions, 4 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f80f6a0..39b68d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2008-09-08 Daniel Kraft <d@domob.eu> + + PR fortran/37199 + * trans-expr.c (gfc_add_interface_mapping): Set new_sym->as. + (gfc_map_intrinsic_function): Added checks against NULL bounds in + array specs. + 2008-09-08 Tobias Burnus <burnus@net.b.de> PR fortran/37400 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index d253976..216b3df 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1618,6 +1618,7 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping, /* Create a new symbol to represent the actual argument. */ new_sym = gfc_new_symbol (sym->name, NULL); new_sym->ts = sym->ts; + new_sym->as = gfc_copy_array_spec (sym->as); new_sym->attr.referenced = 1; new_sym->attr.dimension = sym->attr.dimension; new_sym->attr.pointer = sym->attr.pointer; @@ -1798,8 +1799,9 @@ gfc_apply_interface_mapping_to_ref (gfc_interface_mapping * mapping, /* Convert intrinsic function calls into result expressions. */ + static bool -gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping) +gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping) { gfc_symbol *sym; gfc_expr *new_expr; @@ -1813,7 +1815,7 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping) else arg2 = NULL; - sym = arg1->symtree->n.sym; + sym = arg1->symtree->n.sym; if (sym->attr.dummy) return false; @@ -1850,6 +1852,13 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping) for (; d < dup; d++) { gfc_expr *tmp; + + if (!sym->as->upper[d] || !sym->as->lower[d]) + { + gfc_free_expr (new_expr); + return false; + } + tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]), gfc_int_expr (1)); tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d])); if (new_expr) @@ -1875,9 +1884,15 @@ gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping) gcc_unreachable (); if (expr->value.function.isym->id == GFC_ISYM_LBOUND) - new_expr = gfc_copy_expr (sym->as->lower[d]); + { + if (sym->as->lower[d]) + new_expr = gfc_copy_expr (sym->as->lower[d]); + } else - new_expr = gfc_copy_expr (sym->as->upper[d]); + { + if (sym->as->upper[d]) + new_expr = gfc_copy_expr (sym->as->upper[d]); + } break; default: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index af93d15..ec3132f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-09-08 Daniel Kraft <d@domob.eu> + + PR fortran/37199 + * gfortran.dg/array_function_2.f90: New test. + 2008-09-08 Tobias Burnus <burnus@net.b.de> PR fortran/37400 diff --git a/gcc/testsuite/gfortran.dg/array_function_2.f90 b/gcc/testsuite/gfortran.dg/array_function_2.f90 new file mode 100644 index 0000000..a937411 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_function_2.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } + +! PR fortran/37199 +! We used to produce wrong (segfaulting) code for this one because the +! temporary array for the function result had wrong bounds. + +! Contributed by Gavin Salam <salam@lpthe.jussieu.fr> + +program bounds_issue + implicit none + integer, parameter :: dp = kind(1.0d0) + real(dp), pointer :: pdf0(:,:), dpdf(:,:) + + allocate(pdf0(0:282,-6:7)) + allocate(dpdf(0:282,-6:7)) ! with dpdf(0:283,-6:7) [illegal] error disappears + !write(0,*) lbound(dpdf), ubound(dpdf) + dpdf = tmp_PConv(pdf0) + +contains + function tmp_PConv(q_in) result(Pxq) + real(dp), intent(in) :: q_in(0:,-6:) + real(dp) :: Pxq(0:ubound(q_in,dim=1),-6:7) + Pxq = 0d0 + !write(0,*) lbound(q_in), ubound(q_in) + !write(0,*) lbound(Pxq), ubound(Pxq) + return + end function tmp_PConv + +end program bounds_issue |