This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR18578, PR18579, PR20857 and PR20885 - Constraints on INTENT(OUT and INOUT)
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 29 Jan 2006 07:55:52 +0100
- Subject: [Patch, fortran] PR18578, PR18579, PR20857 and PR20885 - Constraints on INTENT(OUT and INOUT)
:ADDPATCH fortran:
This patch implements the obvious constraints on the use of INTENT(OUT
and INOUT). ie: that the actual argument should be a variable
("definable" in the standard) and that INTENT(OUT) variables should be
defined or intialized before they are used or before return from the
procedure. Several testuite progams had to be modified, by adding
assignments to INTENT(OUT) variables, so that unintended error messages
were not produced. The patch is straightforward. The use of two new
attributes, was_actual and was_lvalue should be noted.
Regtested on Athlon/FC3. OK for 4.2 and 4.1?
Paul
2006-01-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/18578
PR fortran/18579
PR fortran/20857
PR fortran/20885
* interface.c (compare_actual_formal): Error for INTENT(OUT or INOUT)
if actual argument is not a variable.
resolve.c (resolve_symbol): Warning if INTENT(OUT) has never been an
lvalue and was not initialized.
* gfortran.h: Add attribute bitfields was_lvalue and was_actual.
* match.c (gfc_match_assignment): Set lvalue was_lvalue attribute.
* primary.c (gfc_match_actual_arglist): Set was_actual attribute.
(gfc_match_rvalue): If has not been an lvalue, warning, if, as well,
has never been an actual argument, error on rvalue being used
undefined.
2006-01-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/18578
PR fortran/18579
PR fortran/20857
PR fortran/20885
* gfortran.dg/intent_1.f90: New test.
* gfortran.dg/assumed_dummy_2.f90: Assign to INTENT(OUT) to suppress
unintended error.
* gfortran.dg/assumed_size_dt_dummy.f90: The same.
* gfortran.dg/generic_3.f90: The same.
* gfortran.dg/spec_expr_2.f90: The same.
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 110364)
--- gcc/fortran/interface.c (working copy)
*************** compare_actual_formal (gfc_actual_arglis
*** 1273,1278 ****
--- 1273,1288 ----
return 0;
}
+ /* Check intent = OUT/INOUT for definable actual argument. */
+ if (a->expr->expr_type != EXPR_VARIABLE
+ && (f->sym->attr.intent == INTENT_OUT
+ || f->sym->attr.intent == INTENT_INOUT))
+ {
+ gfc_error ("Actual argument at %L must be definable to "
+ "match dummy INTENT = OUT/INOUT", &a->expr->where);
+ return 0;
+ }
+
match:
if (a == actual)
na = i;
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 110365)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 483,488 ****
--- 483,493 ----
modification of type or type parameters is permitted. */
unsigned referenced:1;
+ /* Set if the symbol has been an lvalue or an actual argument. Used to
+ check INTENT usage. */
+ unsigned was_lvalue:1;
+ unsigned was_actual:1;
+
/* Set if the is the symbol for the main program. This is the least
cumbersome way to communicate this function property without
strcmp'ing with __MAIN everywhere. */
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 110364)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_symbol (gfc_symbol * sym)
*** 4747,4752 ****
--- 4747,4760 ----
}
}
+ /* Warn if an INTENT(OUT) variable has never been an l-value. */
+ if (sym->attr.dummy
+ && !sym->attr.use_assoc
+ && sym->attr.intent == INTENT_OUT
+ && !sym->attr.was_lvalue
+ && sym->value == NULL)
+ gfc_warning ("The INTENT(OUT) dummy argument '%s' at %L might be "
+ "undefined.", sym->name, &sym->declared_at);
/* Ensure that derived type formal arguments of a public procedure
are not of a private type. */
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c (revision 110364)
--- gcc/fortran/match.c (working copy)
*************** gfc_match_assignment (void)
*** 859,864 ****
--- 859,865 ----
goto cleanup;
gfc_set_sym_referenced (lvalue->symtree->n.sym);
+ lvalue->symtree->n.sym->attr.was_lvalue = 1;
new_st.op = EXEC_ASSIGN;
new_st.expr = lvalue;
Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c (revision 110364)
--- gcc/fortran/primary.c (working copy)
*************** gfc_match_actual_arglist (int sub_flag,
*** 1521,1526 ****
--- 1521,1529 ----
}
next:
+ if (tail->expr && tail->expr->expr_type == EXPR_VARIABLE)
+ tail->expr->symtree->n.sym->attr.was_actual = 1;
+
if (gfc_match_char (')') == MATCH_YES)
break;
if (gfc_match_char (',') != MATCH_YES)
*************** gfc_match_rvalue (gfc_expr ** result)
*** 1929,1934 ****
--- 1932,1952 ----
e = NULL;
where = gfc_current_locus;
+ if (sym->attr.intent == INTENT_OUT
+ && !sym->value
+ && !sym->attr.was_lvalue)
+ {
+ if (!sym->attr.was_actual)
+ {
+ gfc_error ("Variable '%s' with INTENT(OUT) is being used "
+ "uninitialized at %L.", sym->name, &where);
+ return MATCH_ERROR;
+ }
+ else
+ gfc_warning ("Variable '%s' with INTENT(OUT) might be used "
+ "uninitialized at %L.", sym->name, &where);
+ }
+
gfc_set_sym_referenced (sym);
if (sym->attr.function && sym->result == sym)
Index: gcc/testsuite/gfortran.dg/assumed_dummy_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/assumed_dummy_2.f90 (revision 110364)
--- gcc/testsuite/gfortran.dg/assumed_dummy_2.f90 (working copy)
*************** contains
*** 9,15 ****
end subroutine foo
subroutine bar (arr)
double precision :: arr(5,*)
! call foo (arr) ! { dg-error "cannot be an assumed-size array" }
call foo (arr (:, :8))
end subroutine
end
--- 9,15 ----
end subroutine foo
subroutine bar (arr)
double precision :: arr(5,*)
! call foo (arr) ! { dg-error "cannot be an assumed-size array" }
call foo (arr (:, :8))
end subroutine
end
Index: gcc/testsuite/gfortran.dg/assumed_size_dt_dummy.f90
===================================================================
*** gcc/testsuite/gfortran.dg/assumed_size_dt_dummy.f90 (revision 110364)
--- gcc/testsuite/gfortran.dg/assumed_size_dt_dummy.f90 (working copy)
*************** CONTAINS
*** 10,15 ****
--- 10,18 ----
SUBROUTINE try (A, B) ! { dg-error "cannot have a default initializer" }
TYPE(init), DIMENSION(*), INTENT(OUT) :: A
TYPE(init) , INTENT(OUT) :: B ! PR24440 => segfault
+ TYPE(init) :: C
+ A(1) = C
+ B = C
END SUBROUTINE try
END MODULE TEST
Index: gcc/testsuite/gfortran.dg/spec_expr_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/spec_expr_2.f90 (revision 110364)
--- gcc/testsuite/gfortran.dg/spec_expr_2.f90 (working copy)
***************
*** 4,7 ****
--- 4,8 ----
subroutine lecligne (ligne)
character(len=*), intent(out) :: ligne
character(len=len(ligne)) :: comment
+ ligne = "" ! To prevent INTENT(OUT) undefined warning.
end subroutine lecligne
Index: gcc/testsuite/gfortran.dg/generic_3.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_3.f90 (revision 110364)
--- gcc/testsuite/gfortran.dg/generic_3.f90 (working copy)
*************** contains
*** 9,14 ****
--- 9,16 ----
double precision, intent(out) :: y
double precision, intent(out) :: dy(:)
integer, intent(in) :: ma
+ y = 0d0
+ dy = 0d0
end subroutine gauss
end module fit_functions