OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran] PR 92994 – add more ASSOCIATE checks

Browse Source 
PR fortran/92994
        * primary.c (gfc_match_rvalue): Add some flavor checks
        gfc_matching_procptr_assignment.
        * resolve.c (resolve_assoc_var): Add more checks for invalid targets.

        PR fortran/92994
        * gfortran.dg/associate_50.f90: Update dg-error.
        * gfortran.dg/associate_51.f90: New.

From-SVN: r279853
This commit is contained in:
Tobias Burnus 2020-01-03 08:08:30 +00:00 committed by Tobias Burnus
parent 208cb81f98
commit 4d12437884
6 changed files with 101 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2020-01-03 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92994
* primary.c (gfc_match_rvalue): Add some flavor checks
gfc_matching_procptr_assignment.
* resolve.c (resolve_assoc_var): Add more checks for invalid targets.
2020-01-02 Tobias Burnus <tobias@codesourcery.com>
PR fortran/68020

14
gcc/fortran/primary.c
View File

@ -3447,7 +3447,19 @@ gfc_match_rvalue (gfc_expr **result)
}
if (gfc_matching_procptr_assignment)
goto procptr0;
{
/* It can be a procedure or a derived-type procedure or a not-yet-known
type. */
if (sym->attr.flavor != FL_UNKNOWN
&& sym->attr.flavor != FL_PROCEDURE
&& sym->attr.flavor != FL_PARAMETER
&& sym->attr.flavor != FL_VARIABLE)
{
gfc_error ("Symbol at %C is not appropriate for an expression");
return MATCH_ERROR;
}
goto procptr0;
}
if (sym->attr.function || sym->attr.external || sym->attr.intrinsic)
goto function0;

21
gcc/fortran/resolve.c
View File

@ -8836,9 +8836,20 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
gcc_assert (target->symtree);
tsym = target->symtree->n.sym;
if (tsym->attr.flavor == FL_PROGRAM)
if (tsym->attr.subroutine
|| tsym->attr.external
|| (tsym->attr.function
&& (tsym->result != tsym || tsym->attr.recursive)))
{
gfc_error ("Associating entity %qs at %L is a PROGRAM",
gfc_error ("Associating entity %qs at %L is a procedure name",
tsym->name, &target->where);
return;
}
if (gfc_expr_attr (target).proc_pointer)
{
gfc_error ("Associating entity %qs at %L is a procedure pointer",
tsym->name, &target->where);
return;
}
@ -8851,6 +8862,12 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
if (is_subref_array (target))
sym->attr.subref_array_pointer = 1;
}
else if (target->ts.type == BT_PROCEDURE)
{
gfc_error ("Associating selector-expression at %L yields a procedure",
&target->where);
return;
}
if (target->expr_type == EXPR_NULL)
{

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2020-01-03 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92994
* gfortran.dg/associate_50.f90: Update dg-error.
* gfortran.dg/associate_51.f90: New.
2020-01-03 Jakub Jelinek <jakub@redhat.com>
PR fortran/68020

4
gcc/testsuite/gfortran.dg/associate_50.f90
View File

@ -3,6 +3,6 @@
! Test case by Gerhard Steinmetz.
program p
associate (y => p) ! { dg-error "is a PROGRAM" }
end associate
associate (y => p) ! { dg-error "Invalid association target" }
end associate ! { dg-error "Expecting END PROGRAM statement" }
end program p

54
gcc/testsuite/gfortran.dg/associate_51.f90 Normal file
View File

@ -0,0 +1,54 @@
! { dg-do compile }
!
! PR fortran/92994
!
! Contributed by G. Steinmetz
!
recursive function f() result(z)
associate (y1 => f())
end associate
associate (y2 => f) ! { dg-error "is a procedure name" }
end associate
end
recursive function f2()
associate (y1 => f2()) ! { dg-error "Invalid association target" }
end associate ! { dg-error "Expecting END FUNCTION statement" }
associate (y2 => f2) ! { dg-error "is a procedure name" }
end associate
end
subroutine p2
type t
end type
type(t) :: z = t()
associate (y => t)
end associate
end
subroutine p3
procedure() :: g
associate (y => g) ! { dg-error "is a procedure name" }
end associate
end
subroutine p4
external :: g
associate (y => g) ! { dg-error "is a procedure name" }
end associate
end
recursive subroutine s
associate (y => s) ! { dg-error "is a procedure name" }
end associate
end
recursive subroutine s2
associate (y => (s2)) ! { dg-error "Associating selector-expression at .1. yields a procedure" }
end associate
end
program p
associate (y => (p)) ! { dg-error "Invalid association target" }
end associate ! { dg-error "Expecting END PROGRAM statement" }
end