Commit 7e49f965 by Tobias Schlüter

arith.c (reduce_binary_aa): Fix capitalization.

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.

From-SVN: r128849
parent 0da4c1ea
2007-09-27 Tobias Schlter <tobi@gcc.gnu.org>
* 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 <pault@gcc.gnu.org> 2007-09-27 Paul Thomas <pault@gcc.gnu.org>
PR fortran/33568 PR fortran/33568
......
...@@ -1422,7 +1422,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), ...@@ -1422,7 +1422,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
rc = ARITH_OK; rc = ARITH_OK;
d = op2->value.constructor; d = op2->value.constructor;
if (gfc_check_conformance ("Elemental binary operation", op1, op2) if (gfc_check_conformance ("elemental binary operation", op1, op2)
!= SUCCESS) != SUCCESS)
rc = ARITH_INCOMMENSURATE; rc = ARITH_INCOMMENSURATE;
else else
......
...@@ -957,7 +957,7 @@ gfc_check_dot_product (gfc_expr *vector_a, gfc_expr *vector_b) ...@@ -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)) 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], "intrinsic 'dot_product'", gfc_current_intrinsic_arg[0],
gfc_current_intrinsic_arg[1], &vector_a->where); gfc_current_intrinsic_arg[1], &vector_a->where);
return FAILURE; return FAILURE;
...@@ -1676,7 +1676,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) ...@@ -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). */ /* Check for case matrix_a has shape(m), matrix_b has shape (m, k). */
if (!identical_dimen_shape (matrix_a, 0, matrix_b, 0)) 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", "and '%s' at %L for intrinsic matmul",
gfc_current_intrinsic_arg[0], gfc_current_intrinsic_arg[0],
gfc_current_intrinsic_arg[1], &matrix_a->where); gfc_current_intrinsic_arg[1], &matrix_a->where);
...@@ -1695,7 +1695,7 @@ gfc_check_matmul (gfc_expr *matrix_a, gfc_expr *matrix_b) ...@@ -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). */ - matrix_a has shape (n,m) and matrix_b has shape (m). */
if (!identical_dimen_shape (matrix_a, 1, matrix_b, 0)) 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 " "dimension 1 for argument '%s' at %L for intrinsic "
"matmul", gfc_current_intrinsic_arg[0], "matmul", gfc_current_intrinsic_arg[0],
gfc_current_intrinsic_arg[1], &matrix_a->where); gfc_current_intrinsic_arg[1], &matrix_a->where);
......
...@@ -2556,8 +2556,8 @@ gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2) ...@@ -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) 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)", gfc_error ("Different shape for %s at %L on dimension %d "
_(optype_msgid), &op1->where, d + 1, "(%d and %d)", _(optype_msgid), &op1->where, d + 1,
(int) mpz_get_si (op1_size), (int) mpz_get_si (op1_size),
(int) mpz_get_si (op2_size)); (int) mpz_get_si (op2_size));
...@@ -2696,7 +2696,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform) ...@@ -2696,7 +2696,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
/* Check size of array assignments. */ /* Check size of array assignments. */
if (lvalue->rank != 0 && rvalue->rank != 0 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; return FAILURE;
if (gfc_compare_types (&lvalue->ts, &rvalue->ts)) if (gfc_compare_types (&lvalue->ts, &rvalue->ts))
...@@ -2905,22 +2905,20 @@ gfc_default_initializer (gfc_typespec *ts) ...@@ -2905,22 +2905,20 @@ gfc_default_initializer (gfc_typespec *ts)
gfc_expr *init; gfc_expr *init;
gfc_component *c; gfc_component *c;
init = NULL;
/* See if we have a default initializer. */ /* See if we have a default initializer. */
for (c = ts->derived->components; c; c = c->next) for (c = ts->derived->components; c; c = c->next)
{ if (c->initializer || c->allocatable)
if ((c->initializer || c->allocatable) && init == NULL) break;
init = gfc_get_expr ();
}
if (init == NULL) if (!c)
return NULL; return NULL;
/* Build the constructor. */ /* Build the constructor. */
init = gfc_get_expr ();
init->expr_type = EXPR_STRUCTURE; init->expr_type = EXPR_STRUCTURE;
init->ts = *ts; init->ts = *ts;
init->where = ts->derived->declared_at; init->where = ts->derived->declared_at;
tail = NULL; tail = NULL;
for (c = ts->derived->components; c; c = c->next) for (c = ts->derived->components; c; c = c->next)
{ {
......
...@@ -46,9 +46,9 @@ along with GCC; see the file COPYING3. If not see ...@@ -46,9 +46,9 @@ along with GCC; see the file COPYING3. If not see
static gfc_file *gfc_current_backend_file; static gfc_file *gfc_current_backend_file;
char gfc_msg_bounds[] = N_("Array bound mismatch"); const char gfc_msg_bounds[] = N_("Array bound mismatch");
char gfc_msg_fault[] = N_("Array reference out of bounds"); const char gfc_msg_fault[] = N_("Array reference out of bounds");
char gfc_msg_wrong_return[] = N_("Incorrect function return value"); const char gfc_msg_wrong_return[] = N_("Incorrect function return value");
/* Advance along TREE_CHAIN n times. */ /* Advance along TREE_CHAIN n times. */
......
...@@ -716,9 +716,9 @@ void gfc_apply_interface_mapping (gfc_interface_mapping *, ...@@ -716,9 +716,9 @@ void gfc_apply_interface_mapping (gfc_interface_mapping *,
/* Standard error messages used in all the trans-*.c files. */ /* Standard error messages used in all the trans-*.c files. */
extern char gfc_msg_bounds[]; extern const char gfc_msg_bounds[];
extern char gfc_msg_fault[]; extern const char gfc_msg_fault[];
extern char gfc_msg_wrong_return[]; extern const char gfc_msg_wrong_return[];
#endif /* GFC_TRANS_H */ #endif /* GFC_TRANS_H */
2007-09-27 Tobias Schlter <tobi@gcc.gnu.org>
* 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 <rsandifo@nildram.co.uk> 2007-09-27 Richard Sandiford <rsandifo@nildram.co.uk>
* gcc.dg/c99-tgmath-1.c: Require c99_runtime and add the associated * gcc.dg/c99-tgmath-1.c: Require c99_runtime and add the associated
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr> ! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
! !
real, dimension(3,3), parameter :: a=reshape ((/(i, i = 1,9)/),(/3,3/)) 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,:) real, dimension(2,3) :: c=a(3:2:-1,:)
print *, b print *, b
print *, c print *, c
......
...@@ -12,15 +12,15 @@ character(26) :: ch ...@@ -12,15 +12,15 @@ character(26) :: ch
pi = acos(-1.0) pi = acos(-1.0)
b = pi b = pi
a = cos(b) ! { dg-error "different shape for Array assignment" } a = cos(b) ! { dg-error "Different shape for array assignment" }
a = -pi a = -pi
b = cos(a) ! { dg-error "different shape for Array assignment" } b = cos(a) ! { dg-error "Different shape for array assignment" }
ch = "abcdefghijklmnopqrstuvwxyz" 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 ! 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 end
...@@ -24,7 +24,7 @@ CONTAINS ...@@ -24,7 +24,7 @@ CONTAINS
SUBROUTINE test_2() SUBROUTINE test_2()
INTEGER :: a(2) = 0, b(3) = 0 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:2)) ! ok, slice, stride 1
a = f(b(1:3:2)) ! ok, slice, stride 2 a = f(b(1:3:2)) ! ok, slice, stride 2
END SUBROUTINE END SUBROUTINE
...@@ -37,8 +37,8 @@ CONTAINS ...@@ -37,8 +37,8 @@ CONTAINS
SUBROUTINE test_4() SUBROUTINE test_4()
INTEGER :: a(2,2) = 0, b(3,3) = 0 INTEGER :: a(2,2) = 0, b(3,3) = 0
a = f(b) ! { 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, 1:2)) ! { dg-error "Different shape" }
a = f(b(1:3:2, 1:3:2)) ! ok, same shape a = f(b(1:3:2, 1:3:2)) ! ok, same shape
END SUBROUTINE END SUBROUTINE
END PROGRAM END PROGRAM
...@@ -27,7 +27,7 @@ end module elem_assign ...@@ -27,7 +27,7 @@ end module elem_assign
CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" } CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" }
! Check interface assignments ! Check interface assignments
x = w ! { dg-error "Incompatible ranks in elemental procedure" } 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 x = z
CONTAINS CONTAINS
ELEMENTAL SUBROUTINE S(I,J) ELEMENTAL SUBROUTINE S(I,J)
......
...@@ -3,8 +3,8 @@ program main ...@@ -3,8 +3,8 @@ program main
real :: av(2), bv(4) real :: av(2), bv(4)
real :: a(2,2) real :: a(2,2)
logical :: lo(3,2) logical :: lo(3,2)
print *,dot_product(av, bv) ! { dg-error "different shape" } print *,dot_product(av, bv) ! { dg-error "Different shape" }
print *,pack(a, lo) ! { dg-error "different shape" } print *,pack(a, lo) ! { dg-error "Different shape" }
print *,merge(av, bv, lo(1,:)) ! { dg-error "different shape" } print *,merge(av, bv, lo(1,:)) ! { dg-error "Different shape" }
print *,matmul(bv,a) ! { dg-error "different shape" } print *,matmul(bv,a) ! { dg-error "Different shape" }
end program main end program main
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
integer, dimension(0:1,0:1) :: n integer, dimension(0:1,0:1) :: n
integer, dimension(1) :: i integer, dimension(1) :: i
n = reshape((/1, 2, 3, 4/), shape(n)) n = reshape((/1, 2, 3, 4/), shape(n))
i = maxloc(n) ! { 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" } i = maxloc(n,dim=1) ! { dg-error "Different shape for array assignment" }
! print *,i ! print *,i
end program end program
...@@ -20,16 +20,16 @@ program main ...@@ -20,16 +20,16 @@ program main
print *,sum(a,1,mask=lo) ! { dg-error "Incompatible ranks" } print *,sum(a,1,mask=lo) ! { dg-error "Incompatible ranks" }
print *,product(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 *,minloc(a,mask=lo2) ! { dg-error "Different shape" }
print *,maxloc(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 *,minval(a,mask=lo2) ! { dg-error "Different shape" }
print *,maxval(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 *,sum(a,mask=lo2) ! { dg-error "Different shape" }
print *,product(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 *,minloc(a,1,mask=lo2) ! { dg-error "Different shape" }
print *,maxloc(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 *,minval(a,1,mask=lo2) ! { dg-error "Different shape" }
print *,maxval(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 *,sum(a,1,mask=lo2) ! { dg-error "Different shape" }
print *,product(a,1,mask=lo2) ! { dg-error "different shape" } print *,product(a,1,mask=lo2) ! { dg-error "Different shape" }
end program main end program main
...@@ -20,32 +20,32 @@ program pr31919 ...@@ -20,32 +20,32 @@ program pr31919
r4a = amin1(r4a, r4b) ! { dg-error "Incompatible ranks" } r4a = amin1(r4a, r4b) ! { dg-error "Incompatible ranks" }
r8a = dmin1(r8a, r8b) ! { dg-error "Incompatible ranks" } r8a = dmin1(r8a, r8b) ! { dg-error "Incompatible ranks" }
i4a = max(i4b, i4c) ! { 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" } i4a = max0(i4b, i4c) ! { dg-error "Different shape for arguments" }
r4a = amax0(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" } i4a = max1(r4b, r4c) ! { dg-error "Different shape for arguments" }
r4a = amax1(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" } r8a = dmax1(r8B, r8c) ! { dg-error "Different shape for arguments" }
i4a = min(i4b, i4c) ! { 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 = min0(i4b, i4c) ! { dg-error "Different shape for arguments" }
i4a = amin0(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 = min1(r4b, r4c) ! { dg-error "Different shape for arguments" }
r4a = amin1(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" } r8a = dmin1(r8b, r8c) ! { dg-error "Different shape for arguments" }
! checking needs to be position independent ! checking needs to be position independent
i4a = min(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" } i4a = min(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" }
r4a = min(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" } r4a = min(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" }
r8a = min(r8, r8a, r8, r8b) ! { 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" } i4a = min(i4, i4b, i4, i4c) ! { dg-error "Different shape for arguments" }
r4a = min(r4, r4b, r4, r4c) ! { 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" } r8a = min(r8, r8b, r8, r8c) ! { dg-error "Different shape for arguments" }
i4a = max(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" } i4a = max(i4, i4a, i4, i4b) ! { dg-error "Incompatible ranks" }
r4a = max(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" } r4a = max(r4, r4a, r4, r4b) ! { dg-error "Incompatible ranks" }
r8a = max(r8, r8a, r8, r8b) ! { 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" } i4a = max(i4, i4b, i4, i4c) ! { dg-error "Different shape for arguments" }
r4a = max(r4, r4b, r4, r4c) ! { 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" } r8a = max(r8, r8b, r8, r8c) ! { dg-error "Different shape for arguments" }
end program end program
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment