[patch,fortran] PR 16136: ALLOCATABLE dummy arguments
Erik Edelmann
erik.edelmann@iki.fi
Thu Mar 2 23:47:00 GMT 2006
:ADDPATCH:
Here's a patch that implements support for ALLOCATABLE dummy
arguments. It does the following:
* In symbol.c (check_conflict), the check for a ALLOCATABLE/DUMMY
conflict is made conditional on the selected standard. Since
we may (will) want to allow other conflicts in the future for
standards >= 2003, I did this by creating a new macro conf_std.
* In trans-expr.c (gfc_conv_function_call), treat ALLOCATABLE
dummy arguments the same way as POINTER dummy arguments, i.e.
pass the address of the array descriptor.
* In addition to these things, the patch checks for a few
constraints: The actual argument must be also be ALLOCATABLE
(using the new function compare_allocatable from interface.c
(compare_actual_formal)), and the dummy arguments
mustn't get allocated or deallocated if they are INTENT(IN) (in
resolve.c (resolve_deallocate_expr, resolve_allocate_expr)).
* And of course I added a few lines to gfortran.texi
Tested on trunk, on Linux/x86. Ok to commit?
(I assume that this, being a new language feature, is
inappropriate for 4.1)
Erik
2005-03-03 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/16136
* symbol.c (conf_std): New macro.
(check_conflict): Use it to allow ALLOCATABLE dummy
arguments for F2003.
* trans-expr.c (gfc_conv_function_call): Pass pass the
address of the array descriptor when dummy argument is
ALLOCATABLE.
* interface.c (compare_allocatable): New function.
(compare_actual_formal): Use it.
resolve.c (resolve_deallocate_expr,
resolve_allocate_expr): Check that INTENT(IN) variables
aren't (de)allocated.
* gfortran.texi (Fortran 2003 status): List ALLOCATABLE
dummy arguments as supported.
2005-03-03 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/16136
* allocatable_dummy_1.f90: New.
* allocatable_dummy_2.f90: New.
-------------- next part --------------
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (revision 111646)
+++ gcc/fortran/interface.c (working copy)
@@ -1065,6 +1065,26 @@ symbol_rank (gfc_symbol * sym)
/* Given a symbol of a formal argument list and an expression, if the
+ formal argument is allocatable, check that the actual argument is
+ allocatable. Returns nonzero if compatible, zero if not compatible. */
+
+static int
+compare_allocatable (gfc_symbol * formal, gfc_expr * actual)
+{
+ symbol_attribute attr;
+
+ if (formal->attr.allocatable)
+ {
+ attr = gfc_expr_attr (actual);
+ if (!attr.allocatable)
+ return 0;
+ }
+
+ return 1;
+}
+
+
+/* Given a symbol of a formal argument list and an expression, if the
formal argument is a pointer, see if the actual argument is a
pointer. Returns nonzero if compatible, zero if not compatible. */
@@ -1276,6 +1296,15 @@ compare_actual_formal (gfc_actual_arglis
return 0;
}
+ if (a->expr->expr_type != EXPR_NULL
+ && compare_allocatable (f->sym, a->expr) == 0)
+ {
+ if (where)
+ gfc_error ("Actual argument for '%s' must be ALLOCATABLE at %L",
+ f->sym->name, &a->expr->where);
+ return 0;
+ }
+
/* Check intent = OUT/INOUT for definable actual argument. */
if (a->expr->expr_type != EXPR_VARIABLE
&& (f->sym->attr.intent == INTENT_OUT
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 111646)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -1870,16 +1870,15 @@ gfc_conv_function_call (gfc_se * se, gfc
}
else
{
- /* If the procedure requires an explicit interface, the
- actual argument is passed according to the
- corresponding formal argument. If the corresponding
- formal argument is a POINTER or assumed shape, we do
- not use g77's calling convention, and pass the
- address of the array descriptor instead. Otherwise we
- use g77's calling convention. */
+ /* If the procedure requires an explicit interface, the actual
+ argument is passed according to the corresponding formal
+ argument. If the corresponding formal argument is a POINTER,
+ ALLOCATABLE or assumed shape, we do not use g77's calling
+ convention, and pass the address of the array descriptor
+ instead. Otherwise we use g77's calling convention. */
int f;
f = (formal != NULL)
- && !formal->sym->attr.pointer
+ && !(formal->sym->attr.pointer || formal->sym->attr.allocatable)
&& formal->sym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
if (arg->expr->expr_type == EXPR_VARIABLE
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c (revision 111646)
+++ gcc/fortran/symbol.c (working copy)
@@ -251,6 +251,13 @@ gfc_set_default_type (gfc_symbol * sym,
#define conf(a, b) if (attr->a && attr->b) { a1 = a; a2 = b; goto conflict; }
#define conf2(a) if (attr->a) { a2 = a; goto conflict; }
+#define conf_std(a, b, std) if (attr->a && attr->b)\
+ {\
+ a1 = a;\
+ a2 = b;\
+ standard = std;\
+ goto conflict_std;\
+ }
static try
check_conflict (symbol_attribute * attr, const char * name, locus * where)
@@ -268,6 +275,7 @@ check_conflict (symbol_attribute * attr,
static const char *threadprivate = "THREADPRIVATE";
const char *a1, *a2;
+ int standard;
if (where == NULL)
where = &gfc_current_locus;
@@ -328,7 +336,7 @@ check_conflict (symbol_attribute * attr,
}
conf (allocatable, pointer);
- conf (allocatable, dummy); /* TODO: Allowed in Fortran 200x. */
+ conf_std (allocatable, dummy, GFC_STD_F2003);
conf (allocatable, function); /* TODO: Allowed in Fortran 200x. */
conf (allocatable, result); /* TODO: Allowed in Fortran 200x. */
conf (elemental, recursive);
@@ -519,10 +527,25 @@ conflict:
a1, a2, name, where);
return FAILURE;
+
+conflict_std:
+ if (name == NULL)
+ {
+ return gfc_notify_std (standard, "In the selected standard, %s attribute "
+ "conflicts with %s attribute at %L", a1, a2,
+ where);
+ }
+ else
+ {
+ return gfc_notify_std (standard, "In the selected standard, %s attribute "
+ "conflicts with %s attribute in '%s' at %L",
+ a1, a2, name, where);
+ }
}
#undef conf
#undef conf2
+#undef conf_std
/* Mark a symbol as referenced. */
Index: gcc/fortran/gfortran.texi
===================================================================
--- gcc/fortran/gfortran.texi (revision 111646)
+++ gcc/fortran/gfortran.texi (working copy)
@@ -1331,6 +1331,10 @@ Support for the declaration of enumerati
@command{gcc} is guaranteed also for the case where the
@command{-fshort-enums} command line option is given.
+@item
+@cindex @code{ALLOCATABLE} dummy arguments
+The @code{ALLOCATABLE} attribute for dummy arguments.
+
@end itemize
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 111646)
+++ gcc/fortran/resolve.c (working copy)
@@ -2914,6 +2914,13 @@ resolve_deallocate_expr (gfc_expr * e)
"ALLOCATABLE or a POINTER", &e->where);
}
+ if (e->symtree->n.sym->attr.intent == INTENT_IN)
+ {
+ gfc_error ("Can't deallocate INTENT(IN) variable '%s' at %L",
+ e->symtree->n.sym->name, &e->where);
+ return FAILURE;
+ }
+
return SUCCESS;
}
@@ -3015,6 +3022,13 @@ resolve_allocate_expr (gfc_expr * e, gfc
return FAILURE;
}
+ if (e->symtree->n.sym->attr.intent == INTENT_IN)
+ {
+ gfc_error ("Can't allocate INTENT(IN) variable '%s' at %L",
+ e->symtree->n.sym->name, &e->where);
+ return FAILURE;
+ }
+
/* Add default initializer for those derived types that need them. */
if (e->ts.type == BT_DERIVED && (init_e = gfc_default_initializer (&e->ts)))
{
-------------- next part --------------
! { dg-do run }
! Test procedures with allocatable dummy arguments
program alloc_dummy
implicit none
integer, allocatable :: a(:)
call init(a)
if (.NOT.allocated(a)) call abort()
if (.NOT.all(a == [ 1, 2, 3 ])) call abort()
call kill(a)
if (allocated(a)) call abort()
contains
subroutine init(x)
integer, allocatable, intent(out) :: x(:)
allocate(x(3))
x = [ 1, 2, 3 ]
end subroutine init
subroutine kill(x)
integer, allocatable, intent(out) :: x(:)
deallocate(x)
end subroutine kill
end program alloc_dummy
-------------- next part --------------
! { dg-do compile }
! Check a few constraints for ALLOCATABLE dummy arguments.
program alloc_dummy
implicit none
integer :: a(5)
call init(a) ! { dg-error "must be ALLOCATABLE" }
contains
subroutine init(x)
integer, allocatable, intent(out) :: x(:)
end subroutine init
subroutine init2(x)
integer, allocatable, intent(in) :: x(:)
allocate(x(3)) ! { dg-error "Can't allocate" }
end subroutine init2
subroutine kill(x)
integer, allocatable, intent(in) :: x(:)
deallocate(x) ! { dg-error "Can't deallocate" }
end subroutine kill
end program alloc_dummy
More information about the Fortran
mailing list