[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

gcc/fortran/ChangeLog

+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

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 *);

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)
     {

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  */

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90

+! { 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

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)

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)

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)

gcc/testsuite/gfortran.dg/procedure_lvalue.f90

+! { 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