2008-12-18 Daniel Kraft <d@domob.eu>
authordomob <domob@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 18 Dec 2008 10:05:54 +0000 (10:05 +0000)
committerdomob <domob@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 18 Dec 2008 10:05:54 +0000 (10:05 +0000)
PR fortran/31822
* gfortran.h (gfc_check_same_strlen): Made public.
* trans.h (gfc_trans_same_strlen_check): Made public.
* check.c (gfc_check_same_strlen): Made public and adapted error
message output to be useful not only for intrinsics.
(gfc_check_merge): Adapt to gfc_check_same_strlen change.
* expr.c (gfc_check_pointer_assign): Use gfc_check_same_strlen for
string length compile-time check.
* trans-expr.c (gfc_trans_pointer_assignment): Add runtime-check for
equal string lengths using gfc_trans_same_strlen_check.
* trans-intrinsic.c (gfc_trans_same_strlen_check): Renamed and made
public from conv_same_strlen_check.
(gfc_conv_intrinsic_merge): Adapted accordingly.

2008-12-18  Daniel Kraft  <d@domob.eu>

PR fortran/31822
* gfortran.dg/char_pointer_assign_2.f90: Updated expected error message
to be more detailed.
* gfortran.dg/char_pointer_assign_4.f90: New test.
* gfortran.dg/char_pointer_assign_5.f90: New test.

git-svn-id: svn://gcc.gnu.org/svn/gcc/trunk@142808 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/check.c
gcc/fortran/expr.c
gcc/fortran/gfortran.h
gcc/fortran/trans-expr.c
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
gcc/testsuite/gfortran.dg/char_pointer_assign_4.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/char_pointer_assign_5.f90 [new file with mode: 0644]

index 3cd8c1a..c33c58c 100644 (file)
@@ -1,3 +1,19 @@
+2008-12-18  Daniel Kraft  <d@domob.eu>
+
+       PR fortran/31822
+       * gfortran.h (gfc_check_same_strlen): Made public.
+       * trans.h (gfc_trans_same_strlen_check): Made public.
+       * check.c (gfc_check_same_strlen): Made public and adapted error
+       message output to be useful not only for intrinsics.
+       (gfc_check_merge): Adapt to gfc_check_same_strlen change.
+       * expr.c (gfc_check_pointer_assign): Use gfc_check_same_strlen for
+       string length compile-time check.
+       * trans-expr.c (gfc_trans_pointer_assignment): Add runtime-check for
+       equal string lengths using gfc_trans_same_strlen_check.
+       * trans-intrinsic.c (gfc_trans_same_strlen_check): Renamed and made
+       public from conv_same_strlen_check.
+       (gfc_conv_intrinsic_merge): Adapted accordingly.
+
 2008-12-17  Daniel Kraft  <d@domob.eu>
 
        PR fortran/38137
index 8ca67f2..8b2732b 100644 (file)
@@ -396,8 +396,8 @@ identical_dimen_shape (gfc_expr *a, int ai, gfc_expr *b, int bi)
 /* Check whether two character expressions have the same length;
    returns SUCCESS if they have or if the length cannot be determined.  */
 
-static gfc_try
-check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
+gfc_try
+gfc_check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
 {
    long len_a, len_b;
    len_a = len_b = -1;
@@ -423,8 +423,8 @@ check_same_strlen (const gfc_expr *a, const gfc_expr *b, const char *name)
    if (len_a == len_b)
      return SUCCESS;
 
-   gfc_error ("Unequal character lengths (%ld and %ld) in %s intrinsic "
-             "at %L", len_a, len_b, name, &a->where);
+   gfc_error ("Unequal character lengths (%ld/%ld) in %s at %L",
+             len_a, len_b, name, &a->where);
    return FAILURE;
 }
 
@@ -2011,7 +2011,7 @@ gfc_check_merge (gfc_expr *tsource, gfc_expr *fsource, gfc_expr *mask)
     return FAILURE;
 
   if (tsource->ts.type == BT_CHARACTER)
-    return check_same_strlen (tsource, fsource, "MERGE");
+    return gfc_check_same_strlen (tsource, fsource, "MERGE intrinsic");
 
   return SUCCESS;
 }
index 4bdee7c..8a992ca 100644 (file)
@@ -3179,15 +3179,11 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
   if (rvalue->expr_type == EXPR_NULL)
     return SUCCESS;
 
-  if (lvalue->ts.type == BT_CHARACTER
-      && lvalue->ts.cl && rvalue->ts.cl
-      && lvalue->ts.cl->length && rvalue->ts.cl->length
-      && abs (gfc_dep_compare_expr (lvalue->ts.cl->length,
-                                   rvalue->ts.cl->length)) == 1)
+  if (lvalue->ts.type == BT_CHARACTER)
     {
-      gfc_error ("Different character lengths in pointer "
-                "assignment at %L", &lvalue->where);
-      return FAILURE;
+      gfc_try t = gfc_check_same_strlen (lvalue, rvalue, "pointer assignment");
+      if (t == FAILURE)
+       return FAILURE;
     }
 
   if (rvalue->expr_type == EXPR_VARIABLE && is_subref_array (rvalue))
Simple merge
Simple merge
Simple merge
Simple merge
Simple merge