[multiple changes]

2006-01-28  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/17911
	* expr.c (gfc_check_assign, gfc_check_pointer_assign): Emit error if
	the lvalue is a use associated procedure.

	PR fortran/20895
	PR fortran/25030
	* expr.c (gfc_check_pointer_assign): Emit error if lvalue and rvalue
	character lengths are not the same.  Use gfc_dep_compare_expr for the
	comparison.
	* gfortran.h: Add prototype for gfc_dep_compare_expr.
	* dependency.h: Remove prototype for gfc_dep_compare_expr.

2006-01-29  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/17911
	* gfortran.dg/procedure_lvalue.f90: New test.

	PR fortran/20895
	PR fortran/25030
	* gfortran.dg/char_pointer_assign_2.f90: New test.
	* gfortran.dg/char_result_1.f90: Correct unequal charlen pointer
	assignment to be consistent with standard.
	* gfortran.dg/char_result_2.f90: The same.
	* gfortran.dg/char_result_8.f90: The same.

From-SVN: r110365

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2100d5c3acb9127dbc68577d6a683ac0e70ec170..b5220e1f927a4d28010349af5ce6784c25f2d7fc 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2006-01-28  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/17911
+       * expr.c (gfc_check_assign, gfc_check_pointer_assign): Emit error if
+       the lvalue is a use associated procedure.
+
+       PR fortran/20895
+       PR fortran/25030
+       * expr.c (gfc_check_pointer_assign): Emit error if lvalue and rvalue
+       character lengths are not the same.  Use gfc_dep_compare_expr for the
+       comparison.
+       * gfortran.h: Add prototype for gfc_dep_compare_expr.
+       * dependency.h: Remove prototype for gfc_dep_compare_expr.
+
 2005-01-27  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/25964

diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h
index 7ef2edd97e5080a619908b530224690b5194a836..719f444a8caa1c57fced2bb0ab0085a1e3da271c 100644 (file)
--- a/gcc/fortran/dependency.h
+++ b/gcc/fortran/dependency.h
@@ -27,7 +27,6 @@ int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
                                 gfc_actual_arglist *);
 int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int);
 int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
-int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
 int gfc_expr_is_one (gfc_expr *, int);
 
 int gfc_dep_resolver(gfc_ref *, gfc_ref *);

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 11bf277ae58513d21c03ab2393d5f8f43eb1db03..0e699c26de7af2c580ad5dc9afa4bd8fd6f4822b 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1859,6 +1859,14 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
       return FAILURE;
     }
 
+  if (sym->attr.flavor == FL_PROCEDURE && sym->attr.use_assoc)
+    {
+      gfc_error ("'%s' in the assignment at %L cannot be an l-value "
+                "since it is a procedure", sym->name, &lvalue->where);
+      return FAILURE;
+    }
+
+
   if (rvalue->rank != 0 && lvalue->rank != rvalue->rank)
     {
       gfc_error ("Incompatible ranks %d and %d in assignment at %L",
@@ -1944,6 +1952,15 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
       return FAILURE;
     }
 
+  if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE
+       && lvalue->symtree->n.sym->attr.use_assoc)
+    {
+      gfc_error ("'%s' in the pointer assignment at %L cannot be an "
+                "l-value since it is a procedure",
+                lvalue->symtree->n.sym->name, &lvalue->where);
+      return FAILURE;
+    }
+
   attr = gfc_variable_attr (lvalue, NULL);
   if (!attr.pointer)
     {
@@ -1980,6 +1997,16 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
       return FAILURE;
     }
 
+  if (lvalue->ts.type == BT_CHARACTER
+       && lvalue->ts.cl->length && rvalue->ts.cl->length
+       && abs (gfc_dep_compare_expr (lvalue->ts.cl->length,
+                                     rvalue->ts.cl->length)) == 1)
+    {
+      gfc_error ("Different character lengths in pointer "
+                "assignment at %L", &lvalue->where);
+      return FAILURE;
+    }
+
   attr = gfc_expr_attr (rvalue);
   if (!attr.target && !attr.pointer)
     {

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c8813ec070a2281e51a564608856e59b8bd7667e..a1aaaf09967e0b44848e696969fc237ff9389570 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1967,4 +1967,7 @@ void gfc_show_namespace (gfc_namespace *);
 try gfc_parse_file (void);
 void global_used (gfc_gsymbol *, locus *);
 
+/* dependency.c */
+int gfc_dep_compare_expr (gfc_expr *, gfc_expr *);
+
 #endif /* GCC_GFORTRAN_H  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a5aba92a37be26ff2b7e7233f9b68b42e884caeb..3c19025366961af9d3d1bfd1114d9f5407edc31c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,16 @@
+2006-01-29  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/17911
+       * gfortran.dg/procedure_lvalue.f90: New test.
+
+       PR fortran/20895
+       PR fortran/25030
+       * gfortran.dg/char_pointer_assign_2.f90: New test.
+       * gfortran.dg/char_result_1.f90: Correct unequal charlen pointer
+       assignment to be consistent with standard.
+       * gfortran.dg/char_result_2.f90: The same.
+       * gfortran.dg/char_result_8.f90: The same.
+
 2006-01-28  Zack Weinberg  <zackw@panix.com>
 
        * gcc.dg/Woverlength-strings.c

diff --git a/gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90 b/gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
new file mode 100644 (file)
index 0000000..f99b20f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
@@ -0,0 +1,11 @@
+! { dg-do compile }
+! Tests the fix for PRs20895 and 25030, where pointer assignments
+! of different length characters were accepted.
+  character(4), target :: ch1(2)
+  character(4), pointer :: ch2(:)
+  character(5), pointer :: ch3(:)
+
+  ch2 => ch1  ! Check correct is OK
+  ch3 => ch1  ! { dg-error "Different character lengths" }
+
+end
\ No newline at end of file

diff --git a/gcc/testsuite/gfortran.dg/char_result_1.f90 b/gcc/testsuite/gfortran.dg/char_result_1.f90
index 84799e6a6c2fca32d86856fab069ca2691155bf3..2e0b4ef1426fadc06428b84ec89bce5cc2ce444d 100644 (file)
--- a/gcc/testsuite/gfortran.dg/char_result_1.f90
+++ b/gcc/testsuite/gfortran.dg/char_result_1.f90
@@ -40,11 +40,12 @@ program main
   end interface
 
   integer :: a
-  character (len = 80), target :: text
+  character (len = 80)  :: text
+  character (len = 70), target :: textt
   character (len = 70), pointer :: textp
 
   a = 42
-  textp => text
+  textp => textt
 
   call test (f1 (text), 80)
   call test (f2 (text, text), 110)

diff --git a/gcc/testsuite/gfortran.dg/char_result_2.f90 b/gcc/testsuite/gfortran.dg/char_result_2.f90
index cc4a5c4e11ebb2bba2650874ecd521226fd84b39..b7ecb6669c66762549be911254de425b914ffa1f 100644 (file)
--- a/gcc/testsuite/gfortran.dg/char_result_2.f90
+++ b/gcc/testsuite/gfortran.dg/char_result_2.f90
@@ -39,11 +39,12 @@ program main
   end interface
 
   integer :: a
-  character (len = 80), target :: text
+  character (len = 80) :: text
+  character (len = 70), target :: textt
   character (len = 70), pointer :: textp
 
   a = 42
-  textp => text
+  textp => textt
 
   call test (f1 (textp), 70)
   call test (f2 (textp, textp), 95)

diff --git a/gcc/testsuite/gfortran.dg/char_result_8.f90 b/gcc/testsuite/gfortran.dg/char_result_8.f90
index 4da9febe6066e2ee6578a5c2dab93ccbaf65d2ee..69b119647c4ade178be6cf08a36bf3f23c8d8c92 100644 (file)
--- a/gcc/testsuite/gfortran.dg/char_result_8.f90
+++ b/gcc/testsuite/gfortran.dg/char_result_8.f90
@@ -4,7 +4,7 @@
 program main
   implicit none
 
-  character (len = 100), target :: string
+  character (len = 30), target :: string
 
   call test (f1 (), 30)
   call test (f2 (50), 50)

diff --git a/gcc/testsuite/gfortran.dg/procedure_lvalue.f90 b/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
new file mode 100644 (file)
index 0000000..575c2ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/procedure_lvalue.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+! Tests the fix for PR17911, where a USE associated l-value
+! would cause an ICE in gfc_conv_variable.
+! Test contributed by Tobias Schlueter  <tobi@gcc.gnu.org>
+module t
+  interface a
+     module procedure b
+  end interface
+contains
+  integer function b(x)
+    b = x
+  end function b
+end module t
+
+subroutine r
+  use t
+  b = 1.       ! { dg-error "l-value since it is a procedure" }
+  y = a(1.)
+end subroutine r
\ No newline at end of file