This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR33455 - reject MERGE with character arguments of different length
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 21 Sep 2007 11:38:30 +0200
- Subject: [Patch, Fortran] PR33455 - reject MERGE with character arguments of different length
:ADDPATCH fortran:
"13.7.75 MERGE (TSOURCE, FSOURCE, MASK)"
"FSOURCE shall be of the same type and type parameters as TSOURCE."
We are currently missing a check for the string lengths of tsource and
fsource, which this patch adds.
Build and regression tested on x86-64/Linux
Ok for the trunk?
Tobias
2007-09-21 Tobias Burnus <burnus@net-b.de>
PR fortran/33455
* check.c (check_same_strlen): New function.
(gfc_check_merge): Use it.
2007-09-21 Tobias Burnus <burnus@net-b.de>
PR fortran/33455
* gfortran.dg/merge_char_3.f90: New.
Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c (Revision 128644)
+++ gcc/fortran/check.c (Arbeitskopie)
@@ -400,6 +400,42 @@ identical_dimen_shape (gfc_expr *a, int
}
+/* Check whether two character expressions have the same length;
+ returns SUCCESS if they have or if the length cannot be determined. */
+
+static try
+check_same_strlen (gfc_expr *a, gfc_expr *b)
+{
+ long len_a, len_b;
+ len_a = len_b = -1;
+
+ if (a->ts.cl && a->ts.cl->length
+ && a->ts.cl->length->expr_type == EXPR_CONSTANT)
+ len_a = mpz_get_si (a->ts.cl->length->value.integer);
+ else if (a->expr_type == EXPR_CONSTANT
+ && (a->ts.cl == NULL || a->ts.cl->length == NULL))
+ len_a = a->value.character.length;
+ else
+ return SUCCESS;
+
+ if (b->ts.cl && b->ts.cl->length
+ && b->ts.cl->length->expr_type == EXPR_CONSTANT)
+ len_b = mpz_get_si (b->ts.cl->length->value.integer);
+ else if (b->expr_type == EXPR_CONSTANT
+ && (b->ts.cl == NULL || b->ts.cl->length == NULL))
+ len_b = b->value.character.length;
+ else
+ return SUCCESS;
+
+ if (len_a == len_b)
+ return SUCCESS;
+
+ gfc_error ("Unequal character lengths (%ld and %ld) in MERGE intrinsic "
+ "at %L", len_a, len_b, &a->where);
+ return FAILURE;
+}
+
+
/***** Check functions *****/
/* Check subroutine suitable for intrinsics taking a real argument and
@@ -1823,9 +1859,13 @@ gfc_check_merge (gfc_expr *tsource, gfc_
if (type_check (mask, 2, BT_LOGICAL) == FAILURE)
return FAILURE;
+ if (tsource->ts.type == BT_CHARACTER)
+ return check_same_strlen (tsource, fsource);
+
return SUCCESS;
}
+
try
gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
{
Index: gcc/testsuite/gfortran.dg/merge_char_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/merge_char_3.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/merge_char_3.f90 (Revision 0)
@@ -0,0 +1,12 @@
+! { dg-do compile }
+!
+! See PR fortran/31610
+!
+implicit none
+character(len=2) :: a
+character(len=3) :: b
+print *, merge(a, b, .true.) ! { dg-error "Unequal character lengths" }
+print *, merge(a, 'bbb',.true.) ! { dg-error "Unequal character lengths" }
+print *, merge('aa',b, .true.) ! { dg-error "Unequal character lengths" }
+print *, merge('aa','bbb',.true.) ! { dg-error "Unequal character lengths" }
+end