diff options
| author | Tobias Burnus <burnus@gcc.gnu.org> | 2007-01-05 10:08:37 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2007-01-05 10:08:37 +0100 |
| commit | f17facacf2fcfc3af7a085990bc2618590c597c8 (patch) | |
| tree | f40639a46b029ee6c2ccfe80b9c03b2f7f2cd3fd /gcc/fortran/interface.c | |
| parent | 150f069c1cdecb68a8789151b8b6706eb519d244 (diff) | |
| download | gcc-f17facacf2fcfc3af7a085990bc2618590c597c8.zip gcc-f17facacf2fcfc3af7a085990bc2618590c597c8.tar.gz gcc-f17facacf2fcfc3af7a085990bc2618590c597c8.tar.bz2 | |
re PR fortran/29624 (Fortran 2003: Support intent for pointers)
fortran/
2007-01-05 Tobias Burnus <burnus@net-b.de>
PR fortran/29624
* interface.c (compare_parameter_intent): New function.
(check_intents): Support pointer intents.
* symbol.c (check_conflict): Support pointer intents,
better conflict_std message.
* expr.c (gfc_check_assign,gfc_check_pointer_assign):
Support pointer intents.
* resolve.c (resolve_deallocate_expr,resolve_allocate_expr):
Support pointer intents.
testsuite/
2006-01-05 Tobias Burnus <burnus@net-b.de>
PR fortran/29624
* gfortran.dg/alloc_alloc_expr_1.f90: Add check for
invalid deallocate.
* gfortran.dg/allocatable_dummy_2.f90: Update dg-error.
* gfortran.dg/protected_4.f90: Add pointer intent check.
* gfortran.dg/protected_6.f90: Add pointer intent check.
* gfortran.dg/pointer_intent_1.f90: New test.
* gfortran.dg/pointer_intent_2.f90: New test.
* gfortran.dg/pointer_intent_3.f90: New test.
From-SVN: r120472
Diffstat (limited to 'gcc/fortran/interface.c')
| -rw-r--r-- | gcc/fortran/interface.c | 28 |
1 files changed, 23 insertions, 5 deletions
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 7b0c423..8a1987d 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -1664,6 +1664,27 @@ check_some_aliasing (gfc_formal_arglist * f, gfc_actual_arglist * a) } +/* Given a symbol of a formal argument list and an expression, + return non-zero if their intents are compatible, zero otherwise. */ + +static int +compare_parameter_intent (gfc_symbol * formal, gfc_expr * actual) +{ + if (actual->symtree->n.sym->attr.pointer + && !formal->attr.pointer) + return 1; + + if (actual->symtree->n.sym->attr.intent != INTENT_IN) + return 1; + + if (formal->attr.intent == INTENT_INOUT + || formal->attr.intent == INTENT_OUT) + return 0; + + return 1; +} + + /* Given formal and actual argument lists that correspond to one another, check that they are compatible in the sense that intents are not mismatched. */ @@ -1671,7 +1692,7 @@ check_some_aliasing (gfc_formal_arglist * f, gfc_actual_arglist * a) static try check_intents (gfc_formal_arglist * f, gfc_actual_arglist * a) { - sym_intent a_intent, f_intent; + sym_intent f_intent; for (;; f = f->next, a = a->next) { @@ -1683,12 +1704,9 @@ check_intents (gfc_formal_arglist * f, gfc_actual_arglist * a) if (a->expr == NULL || a->expr->expr_type != EXPR_VARIABLE) continue; - a_intent = a->expr->symtree->n.sym->attr.intent; f_intent = f->sym->attr.intent; - if (a_intent == INTENT_IN - && (f_intent == INTENT_INOUT - || f_intent == INTENT_OUT)) + if (!compare_parameter_intent(f->sym, a->expr)) { gfc_error ("Procedure argument at %L is INTENT(IN) while interface " |