This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] PR17911, PR20895, PR25030 - Checks on assignments
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 28 Jan 2006 17:22:23 +0100
- Subject: [Patch, fortran] PR17911, PR20895, PR25030 - Checks on assignments
:ADDPATCH fortran:
This is a trivial patch that:
(i) Prevents use associated procedures from winding up as lvalues - at
present this, understandably causes an ICE (PR17911).
(ii) Checks that the character length is the same for lvalue and rvalue
in pointer assignments, as required by the standard (PR20895 and PR25030).
This latter required three tests in gfortran.dg to be corrected to make
them standard compliant.
Regetsted on FC3. OK for 4.2 and 4.1?
Paul
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-28 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.
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 110306)
--- gcc/fortran/gfortran.h (working copy)
*************** void gfc_show_namespace (gfc_namespace *
*** 1967,1970 ****
--- 1967,1973 ----
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 */
Index: gcc/fortran/ChangeLog
===================================================================
*** gcc/fortran/ChangeLog (revision 110307)
--- gcc/fortran/ChangeLog (working copy)
***************
*** 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
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 110306)
--- gcc/fortran/expr.c (working copy)
*************** gfc_check_assign (gfc_expr * lvalue, gfc
*** 1859,1864 ****
--- 1859,1872 ----
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",
*************** gfc_check_pointer_assign (gfc_expr * lva
*** 1944,1949 ****
--- 1952,1966 ----
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)
{
*************** gfc_check_pointer_assign (gfc_expr * lva
*** 1980,1985 ****
--- 1997,2012 ----
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)
{
Index: gcc/fortran/dependency.h
===================================================================
*** gcc/fortran/dependency.h (revision 110306)
--- gcc/fortran/dependency.h (working copy)
*************** int gfc_check_fncall_dependency (gfc_exp
*** 27,33 ****
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 *);
--- 27,32 ----
Index: gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/char_pointer_assign_2.f90 (revision 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
Index: gcc/testsuite/gfortran.dg/char_result_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_8.f90 (revision 110306)
--- gcc/testsuite/gfortran.dg/char_result_8.f90 (working copy)
***************
*** 4,10 ****
program main
implicit none
! character (len = 100), target :: string
call test (f1 (), 30)
call test (f2 (50), 50)
--- 4,10 ----
program main
implicit none
! character (len = 30), target :: string
call test (f1 (), 30)
call test (f2 (50), 50)
Index: gcc/testsuite/gfortran.dg/char_result_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_1.f90 (revision 110306)
--- gcc/testsuite/gfortran.dg/char_result_1.f90 (working copy)
*************** program main
*** 40,50 ****
end interface
integer :: a
! character (len = 80), target :: text
character (len = 70), pointer :: textp
a = 42
! textp => text
call test (f1 (text), 80)
call test (f2 (text, text), 110)
--- 40,51 ----
end interface
integer :: a
! character (len = 80) :: text
! character (len = 70), target :: textt
character (len = 70), pointer :: textp
a = 42
! textp => textt
call test (f1 (text), 80)
call test (f2 (text, text), 110)
Index: gcc/testsuite/gfortran.dg/char_result_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_result_2.f90 (revision 110306)
--- gcc/testsuite/gfortran.dg/char_result_2.f90 (working copy)
*************** program main
*** 39,49 ****
end interface
integer :: a
! character (len = 80), target :: text
character (len = 70), pointer :: textp
a = 42
! textp => text
call test (f1 (textp), 70)
call test (f2 (textp, textp), 95)
--- 39,50 ----
end interface
integer :: a
! character (len = 80) :: text
! character (len = 70), target :: textt
character (len = 70), pointer :: textp
a = 42
! textp => textt
call test (f1 (textp), 70)
call test (f2 (textp, textp), 95)
Index: gcc/testsuite/gfortran.dg/procedure_lvalue.f90
===================================================================
*** gcc/testsuite/gfortran.dg/procedure_lvalue.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/procedure_lvalue.f90 (revision 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