[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

10 files changed, 94 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2100d5c..b5220e1 100644
--- 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 7ef2edd..719f444 100644
--- 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 11bf277..0e699c2 100644
--- 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 c8813ec..a1aaaf0 100644
--- 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 a5aba92..3c19025 100644
--- 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
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 84799e6..2e0b4ef 100644
--- 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 cc4a5c4..b7ecb66 100644
--- 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 4da9feb..69b1196 100644
--- 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
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