Revision | 58e7732a2feddf475e72b232bf16494d84a41acf (tree) |
---|---|
Zeit | 2022-11-14 05:19:18 |
Autor | José Rui Faustino de Sousa <jrfsousa@gmai...> |
Commiter | Harald Anlauf |
Fortran: diagnostics for actual arguments to pointer dummy arguments [PR94104]
Error message improvement. In Fortran 2008 actual procedure arguments
associated with a pointer, intent(in) attribute, dummy argument
can also have the target attribute, not just pointer.
gcc/fortran/ChangeLog:
PR fortran/94104
* interface.cc (gfc_compare_actual_formal): Improve error message
dependent on Fortran standard level.
gcc/testsuite/ChangeLog:
PR fortran/94104
* gfortran.dg/parens_2.f90: Adjust to improved error message.
* gfortran.dg/PR94104a.f90: New test.
* gfortran.dg/PR94104b.f90: New test.
@@ -3477,25 +3477,39 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, | ||
3477 | 3477 | goto match; |
3478 | 3478 | } |
3479 | 3479 | |
3480 | - if (a->expr->expr_type != EXPR_NULL | |
3481 | - && compare_pointer (f->sym, a->expr) == 0) | |
3480 | + if (a->expr->expr_type != EXPR_NULL) | |
3482 | 3481 | { |
3483 | - if (where) | |
3484 | - gfc_error ("Actual argument for %qs must be a pointer at %L", | |
3485 | - f->sym->name, &a->expr->where); | |
3486 | - ok = false; | |
3487 | - goto match; | |
3488 | - } | |
3482 | + int cmp = compare_pointer (f->sym, a->expr); | |
3483 | + bool pre2008 = ((gfc_option.allow_std & GFC_STD_F2008) == 0); | |
3489 | 3484 | |
3490 | - if (a->expr->expr_type != EXPR_NULL | |
3491 | - && (gfc_option.allow_std & GFC_STD_F2008) == 0 | |
3492 | - && compare_pointer (f->sym, a->expr) == 2) | |
3493 | - { | |
3494 | - if (where) | |
3495 | - gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " | |
3496 | - "pointer dummy %qs", &a->expr->where,f->sym->name); | |
3497 | - ok = false; | |
3498 | - goto match; | |
3485 | + if (pre2008 && cmp == 0) | |
3486 | + { | |
3487 | + if (where) | |
3488 | + gfc_error ("Actual argument for %qs at %L must be a pointer", | |
3489 | + f->sym->name, &a->expr->where); | |
3490 | + ok = false; | |
3491 | + goto match; | |
3492 | + } | |
3493 | + | |
3494 | + if (pre2008 && cmp == 2) | |
3495 | + { | |
3496 | + if (where) | |
3497 | + gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " | |
3498 | + "pointer dummy %qs", &a->expr->where, f->sym->name); | |
3499 | + ok = false; | |
3500 | + goto match; | |
3501 | + } | |
3502 | + | |
3503 | + if (!pre2008 && cmp == 0) | |
3504 | + { | |
3505 | + if (where) | |
3506 | + gfc_error ("Actual argument for %qs at %L must be a pointer " | |
3507 | + "or a valid target for the dummy pointer in a " | |
3508 | + "pointer assignment statement", | |
3509 | + f->sym->name, &a->expr->where); | |
3510 | + ok = false; | |
3511 | + goto match; | |
3512 | + } | |
3499 | 3513 | } |
3500 | 3514 | |
3501 | 3515 |
@@ -0,0 +1,29 @@ | ||
1 | +! { dg-do compile } | |
2 | +! { dg-options "-std=f2003" } | |
3 | +! | |
4 | +! PR fortran/94104 | |
5 | +! | |
6 | + | |
7 | +program diag_p | |
8 | + implicit none | |
9 | + | |
10 | + integer, parameter :: n = 7 | |
11 | + | |
12 | + integer :: a(n) | |
13 | + integer, target :: b(n) | |
14 | + | |
15 | + a = 1 | |
16 | + print *, sumf(a) ! { dg-error "Actual argument for 'a' at .1. must be a pointer" } | |
17 | + print *, sumf(b) ! { dg-error "Fortran 2008: Non-pointer actual argument at .1. to pointer dummy 'a'" } | |
18 | + | |
19 | +contains | |
20 | + | |
21 | + function sumf(a) result(s) | |
22 | + integer, pointer, intent(in) :: a(:) | |
23 | + | |
24 | + integer :: s | |
25 | + | |
26 | + s = sum(a) | |
27 | + end function sumf | |
28 | + | |
29 | +end program diag_p |
@@ -0,0 +1,29 @@ | ||
1 | +! { dg-do compile } | |
2 | +! { dg-options "-std=f2008" } | |
3 | +! | |
4 | +! PR fortran/94104 | |
5 | +! | |
6 | + | |
7 | +program diag_p | |
8 | + implicit none | |
9 | + | |
10 | + integer, parameter :: n = 7 | |
11 | + | |
12 | + integer :: a(n) | |
13 | + integer, target :: b(n) | |
14 | + | |
15 | + a = 1 | |
16 | + print *, sumf(a) ! { dg-error "Actual argument for 'a' at .1. must be a pointer or a valid target" } | |
17 | + print *, sumf(b) | |
18 | + | |
19 | +contains | |
20 | + | |
21 | + function sumf(a) result(s) | |
22 | + integer, pointer, intent(in) :: a(:) | |
23 | + | |
24 | + integer :: s | |
25 | + | |
26 | + s = sum(a) | |
27 | + end function sumf | |
28 | + | |
29 | +end program diag_p |
@@ -2,7 +2,7 @@ | ||
2 | 2 | ! { dg-do compile } |
3 | 3 | ! Originally contributed by Joost VandeVondele |
4 | 4 | INTEGER, POINTER :: I |
5 | -CALL S1((I)) ! { dg-error "Actual argument for .i. must be a pointer" } | |
5 | +CALL S1((I)) ! { dg-error "Actual argument for .i. at .1. must be a pointer or a valid target" } | |
6 | 6 | CONTAINS |
7 | 7 | SUBROUTINE S1(I) |
8 | 8 | INTEGER, POINTER ::I |