From b809df7a44ccd727ab273a55e7c994233051e061 Mon Sep 17 00:00:00 2001 From: tobi Date: Thu, 27 Sep 2007 21:27:51 +0000 Subject: [PATCH] fortran/ * arith.c (reduce_binary_aa): Fix capitalization. * check.c (gfc_check_dot_product): Likewise. (gfc_check_matmul): Likewise. * expr.c (gfc_check_conformance): Likewise. (gfc_check_assign): Likewise. (gfc_default_initializer): Simplify logic. * trans.c (gfc_msg_bounds): Make const. (gfc_msg_fault): Likewise. (gfc_msg_wrong_return): Likewise. * trans.h: Add const to corresponding extern declarations. testsuite/ * gfortran.dg/array_initializer_3.f90: Adapt error annotations for fixed capitalizations. * gfortran.dg/compliant_elemental_intrinsics_1.f90: Likewise. * gfortran.dg/compliant_elemental_intrinsics_2.f90: Likewise. * gfortran.dg/elemental_subroutine_4.f90: Likewise. * gfortran.dg/intrinsic_argument_conformance_1.f90: Likewise. * gfortran.dg/maxloc_shape_1.f90: Likewise. * gfortran.dg/maxval_maxloc_conformance_1.f90: Likewise. * gfortran.dg/min_max_conformance.f90: Likewise. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128849 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 13 ++++++++ gcc/fortran/arith.c | 2 +- gcc/fortran/check.c | 6 ++-- gcc/fortran/expr.c | 18 +++++------ gcc/fortran/trans.c | 6 ++-- gcc/fortran/trans.h | 6 ++-- gcc/testsuite/ChangeLog | 12 ++++++++ gcc/testsuite/gfortran.dg/array_initializer_3.f90 | 2 +- .../compliant_elemental_intrinsics_1.f90 | 8 ++--- .../compliant_elemental_intrinsics_2.f90 | 6 ++-- .../gfortran.dg/elemental_subroutine_4.f90 | 2 +- .../intrinsic_argument_conformance_1.f90 | 8 ++--- gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 | 4 +-- .../gfortran.dg/maxval_maxloc_conformance_1.f90 | 24 +++++++-------- gcc/testsuite/gfortran.dg/min_max_conformance.f90 | 36 +++++++++++----------- 15 files changed, 88 insertions(+), 65 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1e06226268e..494036620ba 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2007-09-27 Tobias Schlüter + + * arith.c (reduce_binary_aa): Fix capitalization. + * check.c (gfc_check_dot_product): Likewise. + (gfc_check_matmul): Likewise. + * expr.c (gfc_check_conformance): Likewise. + (gfc_check_assign): Likewise. + (gfc_default_initializer): Simplify logic. + * trans.c (gfc_msg_bounds): Make const. + (gfc_msg_fault): Likewise. + (gfc_msg_wrong_return): Likewise. + * trans.h: Add const to corresponding extern declarations. + 2007-09-27 Paul Thomas PR fortran/33568 diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c index 7e3d0a4f24c..97d093f31ea 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.c @@ -1422,7 +1422,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), rc = ARITH_OK; d = op2->value.constructor; - if (gfc_check_conformance ("Elemental binary operation", op1, op2) + if (gfc_check_conformance ("elemental binary operation", op1, op2) != SUCCESS) rc = ARITH_INCOMMENSURATE; else diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 6f6a805d832..b6c47dad990 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -957,7 +957,7 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b) if (! identical_dimen_shape (vector_a, 0, vector_b, 0)) { - gfc_error ("different shape for arguments '%s' and '%s' at %L for " + gfc_error ("Different shape for arguments '%s' and '%s' at %L for " "intrinsic 'dot_product'", gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[1], &vector_a->where); return FAILURE; @@ -1676,7 +1676,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) /* Check for case matrix_a has shape(m), matrix_b has shape (m, k). */ if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0)) { - gfc_error ("different shape on dimension 1 for arguments '%s' " + gfc_error ("Different shape on dimension 1 for arguments '%s' " "and '%s' at %L for intrinsic matmul", gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[1], &matrix_a->where); @@ -1695,7 +1695,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) - matrix_a has shape (n,m) and matrix_b has shape (m). */ if (!identical_dimen_shape (matrix_a, 1, matrix_b, 0)) { - gfc_error ("different shape on dimension 2 for argument '%s' and " + gfc_error ("Different shape on dimension 2 for argument '%s' and " "dimension 1 for argument '%s' at %L for intrinsic " "matmul", gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[1], &matrix_a->where); diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 815612e43a6..0c68095e6a8 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2556,8 +2556,8 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0) { - gfc_error ("different shape for %s at %L on dimension %d (%d and %d)", - _(optype_msgid), &op1->where, d + 1, + gfc_error ("Different shape for %s at %L on dimension %d " + "(%d and %d)", _(optype_msgid), &op1->where, d + 1, (int) mpz_get_si (op1_size), (int) mpz_get_si (op2_size)); @@ -2696,7 +2696,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) /* Check size of array assignments. */ if (lvalue->rank != 0 && rvalue->rank != 0 - && gfc_check_conformance ("Array assignment", lvalue, rvalue) != SUCCESS) + && gfc_check_conformance ("array assignment", lvalue, rvalue) != SUCCESS) return FAILURE; if (gfc_compare_types (&lvalue->ts, &rvalue->ts)) @@ -2905,22 +2905,20 @@ gfc_default_initializer (gfc_typespec *ts) gfc_expr *init; gfc_component *c; - init = NULL; - /* See if we have a default initializer. */ for (c = ts->derived->components; c; c = c->next) - { - if ((c->initializer || c->allocatable) && init == NULL) - init = gfc_get_expr (); - } + if (c->initializer || c->allocatable) + break; - if (init == NULL) + if (!c) return NULL; /* Build the constructor. */ + init = gfc_get_expr (); init->expr_type = EXPR_STRUCTURE; init->ts = *ts; init->where = ts->derived->declared_at; + tail = NULL; for (c = ts->derived->components; c; c = c->next) { diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 0d036aadfa1..d2e2b5ab4d2 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -46,9 +46,9 @@ along with GCC; see the file COPYING3. If not see static gfc_file *gfc_current_backend_file; -char gfc_msg_bounds[] = N_("Array bound mismatch"); -char gfc_msg_fault[] = N_("Array reference out of bounds"); -char gfc_msg_wrong_return[] = N_("Incorrect function return value"); +const char gfc_msg_bounds[] = N_("Array bound mismatch"); +const char gfc_msg_fault[] = N_("Array reference out of bounds"); +const char gfc_msg_wrong_return[] = N_("Incorrect function return value"); /* Advance along TREE_CHAIN n times. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 58bdf3d1ac4..7bff3aa14b4 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -716,9 +716,9 @@ void gfc_apply_interface_mapping (gfc_interface_mapping *, /* Standard error messages used in all the trans-*.c files. */ -extern char gfc_msg_bounds[]; -extern char gfc_msg_fault[]; -extern char gfc_msg_wrong_return[]; +extern const char gfc_msg_bounds[]; +extern const char gfc_msg_fault[]; +extern const char gfc_msg_wrong_return[]; #endif /* GFC_TRANS_H */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 619e6253922..bfc1af73e67 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +2007-09-27 Tobias Schlüter + + * gfortran.dg/array_initializer_3.f90: Adapt error annotations for + fixed capitalizations. + * gfortran.dg/compliant_elemental_intrinsics_1.f90: Likewise. + * gfortran.dg/compliant_elemental_intrinsics_2.f90: Likewise. + * gfortran.dg/elemental_subroutine_4.f90: Likewise. + * gfortran.dg/intrinsic_argument_conformance_1.f90: Likewise. + * gfortran.dg/maxloc_shape_1.f90: Likewise. + * gfortran.dg/maxval_maxloc_conformance_1.f90: Likewise. + * gfortran.dg/min_max_conformance.f90: Likewise. + 2007-09-27 Richard Sandiford * gcc.dg/c99-tgmath-1.c: Require c99_runtime and add the associated diff --git a/gcc/testsuite/gfortran.dg/array_initializer_3.f90 b/gcc/testsuite/gfortran.dg/array_initializer_3.f90 index fd35875d2af..c420e95dc73 100644 --- a/gcc/testsuite/gfortran.dg/array_initializer_3.f90 +++ b/gcc/testsuite/gfortran.dg/array_initializer_3.f90 @@ -6,7 +6,7 @@ ! Contributed by Dominique d'Humieres ! real, dimension(3,3), parameter :: a=reshape ((/(i, i = 1,9)/),(/3,3/)) -real, dimension(2,3) :: b=a(:2:-1,:) ! { dg-error "different shape for Array assignment" } +real, dimension(2,3) :: b=a(:2:-1,:) ! { dg-error "Different shape for array assignment" } real, dimension(2,3) :: c=a(3:2:-1,:) print *, b print *, c diff --git a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90 b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90 index 7829d977eb2..19cef2bfd8e 100644 --- a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90 +++ b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_1.f90 @@ -12,15 +12,15 @@ character(26) :: ch pi = acos(-1.0) b = pi -a = cos(b) ! { dg-error "different shape for Array assignment" } +a = cos(b) ! { dg-error "Different shape for array assignment" } a = -pi -b = cos(a) ! { dg-error "different shape for Array assignment" } +b = cos(a) ! { dg-error "Different shape for array assignment" } ch = "abcdefghijklmnopqrstuvwxyz" -a = transfer (ch, pi, 3) ! { dg-error "different shape for Array assignment" } +a = transfer (ch, pi, 3) ! { dg-error "Different shape for array assignment" } ! This already generated an error -b = reshape ((/1.0/),(/1/)) ! { dg-error "different shape for Array assignment" } +b = reshape ((/1.0/),(/1/)) ! { dg-error "Different shape for array assignment" } end diff --git a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 index 8409b0759e1..0ced3301f1f 100644 --- a/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 +++ b/gcc/testsuite/gfortran.dg/compliant_elemental_intrinsics_2.f90 @@ -24,7 +24,7 @@ CONTAINS SUBROUTINE test_2() INTEGER :: a(2) = 0, b(3) = 0 - a = f(b) ! { dg-error "different shape" } + a = f(b) ! { dg-error "Different shape" } a = f(b(1:2)) ! ok, slice, stride 1 a = f(b(1:3:2)) ! ok, slice, stride 2 END SUBROUTINE @@ -37,8 +37,8 @@ CONTAINS SUBROUTINE test_4() INTEGER :: a(2,2) = 0, b(3,3) = 0 - a = f(b) ! { dg-error "different shape" } - a = f(b(1:3, 1:2)) ! { dg-error "different shape" } + a = f(b) ! { dg-error "Different shape" } + a = f(b(1:3, 1:2)) ! { dg-error "Different shape" } a = f(b(1:3:2, 1:3:2)) ! ok, same shape END SUBROUTINE END PROGRAM diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 index 1c5b1f7060a..9d2bc492f5c 100644 --- a/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 +++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_4.f90 @@ -27,7 +27,7 @@ end module elem_assign CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" } ! Check interface assignments x = w ! { dg-error "Incompatible ranks in elemental procedure" } - x = y ! { dg-error "different shape for elemental procedure" } + x = y ! { dg-error "Different shape for elemental procedure" } x = z CONTAINS ELEMENTAL SUBROUTINE S(I,J) diff --git a/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90 b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90 index bfdcf429ebb..40f53824221 100644 --- a/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90 +++ b/gcc/testsuite/gfortran.dg/intrinsic_argument_conformance_1.f90 @@ -3,8 +3,8 @@ program main real :: av(2), bv(4) real :: a(2,2) logical :: lo(3,2) - print *,dot_product(av, bv) ! { dg-error "different shape" } - print *,pack(a, lo) ! { dg-error "different shape" } - print *,merge(av, bv, lo(1,:)) ! { dg-error "different shape" } - print *,matmul(bv,a) ! { dg-error "different shape" } + print *,dot_product(av, bv) ! { dg-error "Different shape" } + print *,pack(a, lo) ! { dg-error "Different shape" } + print *,merge(av, bv, lo(1,:)) ! { dg-error "Different shape" } + print *,matmul(bv,a) ! { dg-error "Different shape" } end program main diff --git a/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 b/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 index 69f5866d0e7..0004f67f969 100644 --- a/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 +++ b/gcc/testsuite/gfortran.dg/maxloc_shape_1.f90 @@ -8,7 +8,7 @@ integer, dimension(0:1,0:1) :: n integer, dimension(1) :: i n = reshape((/1, 2, 3, 4/), shape(n)) - i = maxloc(n) ! { dg-error "different shape for Array assignment" } - i = maxloc(n,dim=1) ! { dg-error "different shape for Array assignment" } + i = maxloc(n) ! { dg-error "Different shape for array assignment" } + i = maxloc(n,dim=1) ! { dg-error "Different shape for array assignment" } ! print *,i end program diff --git a/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 b/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 index 828655cbff0..3925eca31c4 100644 --- a/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 +++ b/gcc/testsuite/gfortran.dg/maxval_maxloc_conformance_1.f90 @@ -20,16 +20,16 @@ program main print *,sum(a,1,mask=lo) ! { dg-error "Incompatible ranks" } print *,product(a,1,mask=lo) ! { dg-error "Incompatible ranks" } - print *,minloc(a,mask=lo2) ! { dg-error "different shape" } - print *,maxloc(a,mask=lo2) ! { dg-error "different shape" } - print *,minval(a,mask=lo2) ! { dg-error "different shape" } - print *,maxval(a,mask=lo2) ! { dg-error "different shape" } - print *,sum(a,mask=lo2) ! { dg-error "different shape" } - print *,product(a,mask=lo2) ! { dg-error "different shape" } - print *,minloc(a,1,mask=lo2) ! { dg-error "different shape" } - print *,maxloc(a,1,mask=lo2) ! { dg-error "different shape" } - print *,minval(a,1,mask=lo2) ! { dg-error "different shape" } - print *,maxval(a,1,mask=lo2) ! { dg-error "different shape" } - print *,sum(a,1,mask=lo2) ! { dg-error "different shape" } - print *,product(a,1,mask=lo2) ! { dg-error "different shape" } + print *,minloc(a,mask=lo2) ! { dg-error "Different shape" } + print *,maxloc(a,mask=lo2) ! { dg-error "Different shape" } + print *,minval(a,mask=lo2) ! { dg-error "Different shape" } + print *,maxval(a,mask=lo2) ! { dg-error "Different shape" } + print *,sum(a,mask=lo2) ! { dg-error "Different shape" } + print *,product(a,mask=lo2) ! { dg-error "Different shape" } + print *,minloc(a,1,mask=lo2) ! { dg-error "Different shape" } + print *,maxloc(a,1,mask=lo2) ! { dg-error "Different shape" } + print *,minval(a,1,mask=lo2) ! { dg-error "Different shape" } + print *,maxval(a,1,mask=lo2) ! { dg-error "Different shape" } + print *,sum(a,1,mask=lo2) ! { dg-error "Different shape" } + print *,product(a,1,mask=lo2) ! { dg-error "Different shape" } end program main diff --git a/gcc/testsuite/gfortran.dg/min_max_conformance.f90 b/gcc/testsuite/gfortran.dg/min_max_conformance.f90 index be181eb14bf..57e37d0e76b 100644 --- a/gcc/testsuite/gfortran.dg/min_max_conformance.f90 +++ b/gcc/testsuite/gfortran.dg/min_max_conformance.f90 @@ -20,32 +20,32 @@ program pr31919 r4a = amin1(r4a, r4b) ! { dg-error "Incompatible ranks" } r8a = dmin1(r8a, r8b) ! { dg-error "Incompatible ranks" } - i4a = max(i4b, i4c) ! { dg-error "different shape for arguments" } - i4a = max0(i4b, i4c) ! { dg-error "different shape for arguments" } - r4a = amax0(i4b, i4c) ! { dg-error "different shape for arguments" } - i4a = max1(r4b, r4c) ! { dg-error "different shape for arguments" } - r4a = amax1(r4b, r4c) ! { dg-error "different shape for arguments" } - r8a = dmax1(r8B, r8c) ! { dg-error "different shape for arguments" } + i4a = max(i4b, i4c) ! { dg-error "Different shape for arguments" } + i4a = max0(i4b, i4c) ! { dg-error "Different shape for arguments" } + r4a = amax0(i4b, i4c) ! { dg-error "Different shape for arguments" } + i4a = max1(r4b, r4c) ! { dg-error "Different shape for arguments" } + r4a = amax1(r4b, r4c) ! { dg-error "Different shape for arguments" } + r8a = dmax1(r8B, r8c) ! { dg-error "Different shape for arguments" } - i4a = min(i4b, i4c) ! { dg-error "different shape for arguments" } - i4a = min0(i4b, i4c) ! { dg-error "different shape for arguments" } - i4a = amin0(i4b, i4c) ! { dg-error "different shape for arguments" } - r4a = min1(r4b, r4c) ! { dg-error "different shape for arguments" } - r4a = amin1(r4b, r4c) ! { dg-error "different shape for arguments" } - r8a = dmin1(r8b, r8c) ! { dg-error "different shape for arguments" } + i4a = min(i4b, i4c) ! { dg-error "Different shape for arguments" } + i4a = min0(i4b, i4c) ! { dg-error "Different shape for arguments" } + i4a = amin0(i4b, i4c) ! { dg-error "Different shape for arguments" } + r4a = min1(r4b, r4c) ! { dg-error "Different shape for arguments" } + r4a = amin1(r4b, r4c) ! { dg-error "Different shape for arguments" } + r8a = dmin1(r8b, r8c) ! { dg-error "Different shape for arguments" } ! checking needs to be position independent i4a = min(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" } r4a = min(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" } r8a = min(r8, r8a, r8, r8b) ! { dg-error "Incompatible ranks" } - i4a = min(i4, i4b, i4, i4c) ! { dg-error "different shape for arguments" } - r4a = min(r4, r4b, r4, r4c) ! { dg-error "different shape for arguments" } - r8a = min(r8, r8b, r8, r8c) ! { dg-error "different shape for arguments" } + i4a = min(i4, i4b, i4, i4c) ! { dg-error "Different shape for arguments" } + r4a = min(r4, r4b, r4, r4c) ! { dg-error "Different shape for arguments" } + r8a = min(r8, r8b, r8, r8c) ! { dg-error "Different shape for arguments" } i4a = max(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" } r4a = max(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" } r8a = max(r8, r8a, r8, r8b) ! { dg-error "Incompatible ranks" } - i4a = max(i4, i4b, i4, i4c) ! { dg-error "different shape for arguments" } - r4a = max(r4, r4b, r4, r4c) ! { dg-error "different shape for arguments" } - r8a = max(r8, r8b, r8, r8c) ! { dg-error "different shape for arguments" } + i4a = max(i4, i4b, i4, i4c) ! { dg-error "Different shape for arguments" } + r4a = max(r4, r4b, r4, r4c) ! { dg-error "Different shape for arguments" } + r8a = max(r8, r8b, r8, r8c) ! { dg-error "Different shape for arguments" } end program -- 2.11.0