re PR fortran/90988 (Wrong error message with variables named "PUBLIC*")
2019-06-24 Steven G. Kargl <kargl@gcc.gnu.org> PR Fortran/90988 * decl.c (access_attr_decl): Use temporary variable to reduce unreadability of code. Normalize jumping to return. (gfc_match_protected): Fix parsing error. Add comments to explain code. Remove dead code. (gfc_match_private): Use temporary variable to reduce unreadability of code. Fix parsing error. Move code to test for blank PRIVATE. Remove dead code. (gfc_match_public): Move code to test for blank PUBLIC. Fix parsing error. Remove dead code. 2019-06-24 Steven G. Kargl <kargl@gcc.gnu.org> PR Fortran/90988 * gfortran.dg/pr90988_1.f90: New test. * gfortran.dg/pr90988_2.f90: Ditto. * gfortran.dg/pr90988_3.f90: Ditto. From-SVN: r272667
This commit is contained in:
Steven G. Kargl
parent
07525dad06
commit
b48826985b
4 changed files with 110 additions and 51 deletions
|
|
@ -8788,6 +8788,7 @@ access_attr_decl (gfc_statement st)
|
|||
gfc_symbol *sym, *dt_sym;
|
||||
gfc_intrinsic_op op;
|
||||
match m;
|
||||
gfc_access access = (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
|
||||
|
||||
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
|
||||
goto done;
|
||||
|
|
@ -8798,7 +8799,7 @@ access_attr_decl (gfc_statement st)
|
|||
if (m == MATCH_NO)
|
||||
goto syntax;
|
||||
if (m == MATCH_ERROR)
|
||||
return MATCH_ERROR;
|
||||
goto done;
|
||||
|
||||
switch (type)
|
||||
{
|
||||
|
|
@ -8818,18 +8819,12 @@ access_attr_decl (gfc_statement st)
|
|||
&& sym->attr.flavor == FL_UNKNOWN)
|
||||
sym->attr.flavor = FL_PROCEDURE;
|
||||
|
||||
if (!gfc_add_access (&sym->attr,
|
||||
(st == ST_PUBLIC)
|
||||
? ACCESS_PUBLIC : ACCESS_PRIVATE,
|
||||
sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
if (!gfc_add_access (&sym->attr, access, sym->name, NULL))
|
||||
goto done;
|
||||
|
||||
if (sym->attr.generic && (dt_sym = gfc_find_dt_in_generic (sym))
|
||||
&& !gfc_add_access (&dt_sym->attr,
|
||||
(st == ST_PUBLIC)
|
||||
? ACCESS_PUBLIC : ACCESS_PRIVATE,
|
||||
sym->name, NULL))
|
||||
return MATCH_ERROR;
|
||||
&& !gfc_add_access (&dt_sym->attr, access, sym->name, NULL))
|
||||
goto done;
|
||||
|
||||
break;
|
||||
|
||||
|
|
@ -8838,17 +8833,14 @@ access_attr_decl (gfc_statement st)
|
|||
{
|
||||
gfc_intrinsic_op other_op;
|
||||
|
||||
gfc_current_ns->operator_access[op] =
|
||||
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
|
||||
gfc_current_ns->operator_access[op] = access;
|
||||
|
||||
/* Handle the case if there is another op with the same
|
||||
function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on. */
|
||||
other_op = gfc_equivalent_op (op);
|
||||
|
||||
if (other_op != INTRINSIC_NONE)
|
||||
gfc_current_ns->operator_access[other_op] =
|
||||
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
|
||||
|
||||
gfc_current_ns->operator_access[other_op] = access;
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -8864,8 +8856,7 @@ access_attr_decl (gfc_statement st)
|
|||
|
||||
if (uop->access == ACCESS_UNKNOWN)
|
||||
{
|
||||
uop->access = (st == ST_PUBLIC)
|
||||
? ACCESS_PUBLIC : ACCESS_PRIVATE;
|
||||
uop->access = access;
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -8898,6 +8889,13 @@ gfc_match_protected (void)
|
|||
{
|
||||
gfc_symbol *sym;
|
||||
match m;
|
||||
char c;
|
||||
|
||||
/* PROTECTED has already been seen, but must be followed by whitespace
|
||||
or ::. */
|
||||
c = gfc_peek_ascii_char ();
|
||||
if (!gfc_is_whitespace (c) && c != ':')
|
||||
return MATCH_NO;
|
||||
|
||||
if (!gfc_current_ns->proc_name
|
||||
|| gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
|
||||
|
|
@ -8908,14 +8906,12 @@ gfc_match_protected (void)
|
|||
|
||||
}
|
||||
|
||||
gfc_match (" ::");
|
||||
|
||||
if (!gfc_notify_std (GFC_STD_F2003, "PROTECTED statement at %C"))
|
||||
return MATCH_ERROR;
|
||||
|
||||
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
|
||||
{
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
/* PROTECTED has an entity-list. */
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
goto syntax;
|
||||
|
||||
|
|
@ -8958,41 +8954,48 @@ syntax:
|
|||
match
|
||||
gfc_match_private (gfc_statement *st)
|
||||
{
|
||||
gfc_state_data *prev;
|
||||
char c;
|
||||
|
||||
if (gfc_match ("private") != MATCH_YES)
|
||||
return MATCH_NO;
|
||||
|
||||
/* Try matching PRIVATE without an access-list. */
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
{
|
||||
prev = gfc_state_stack->previous;
|
||||
if (gfc_current_state () != COMP_MODULE
|
||||
&& !(gfc_current_state () == COMP_DERIVED
|
||||
&& prev && prev->state == COMP_MODULE)
|
||||
&& !(gfc_current_state () == COMP_DERIVED_CONTAINS
|
||||
&& prev->previous && prev->previous->state == COMP_MODULE))
|
||||
{
|
||||
gfc_error ("PRIVATE statement at %C is only allowed in the "
|
||||
"specification part of a module");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
*st = ST_PRIVATE;
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
||||
/* At this point, PRIVATE must be followed by whitespace or ::. */
|
||||
c = gfc_peek_ascii_char ();
|
||||
if (!gfc_is_whitespace (c) && c != ':')
|
||||
return MATCH_NO;
|
||||
|
||||
prev = gfc_state_stack->previous;
|
||||
if (gfc_current_state () != COMP_MODULE
|
||||
&& !(gfc_current_state () == COMP_DERIVED
|
||||
&& gfc_state_stack->previous
|
||||
&& gfc_state_stack->previous->state == COMP_MODULE)
|
||||
&& prev && prev->state == COMP_MODULE)
|
||||
&& !(gfc_current_state () == COMP_DERIVED_CONTAINS
|
||||
&& gfc_state_stack->previous && gfc_state_stack->previous->previous
|
||||
&& gfc_state_stack->previous->previous->state == COMP_MODULE))
|
||||
&& prev->previous && prev->previous->state == COMP_MODULE))
|
||||
{
|
||||
gfc_error ("PRIVATE statement at %C is only allowed in the "
|
||||
"specification part of a module");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_current_state () == COMP_DERIVED)
|
||||
{
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
{
|
||||
*st = ST_PRIVATE;
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
||||
gfc_syntax_error (ST_PRIVATE);
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
{
|
||||
*st = ST_PRIVATE;
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
||||
*st = ST_ATTR_DECL;
|
||||
return access_attr_decl (ST_PRIVATE);
|
||||
}
|
||||
|
|
@ -9001,10 +9004,30 @@ gfc_match_private (gfc_statement *st)
|
|||
match
|
||||
gfc_match_public (gfc_statement *st)
|
||||
{
|
||||
char c;
|
||||
|
||||
if (gfc_match ("public") != MATCH_YES)
|
||||
return MATCH_NO;
|
||||
|
||||
/* Try matching PUBLIC without an access-list. */
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
{
|
||||
if (gfc_current_state () != COMP_MODULE)
|
||||
{
|
||||
gfc_error ("PUBLIC statement at %C is only allowed in the "
|
||||
"specification part of a module");
|
||||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
*st = ST_PUBLIC;
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
||||
/* At this point, PUBLIC must be followed by whitespace or ::. */
|
||||
c = gfc_peek_ascii_char ();
|
||||
if (!gfc_is_whitespace (c) && c != ':')
|
||||
return MATCH_NO;
|
||||
|
||||
if (gfc_current_state () != COMP_MODULE)
|
||||
{
|
||||
gfc_error ("PUBLIC statement at %C is only allowed in the "
|
||||
|
|
@ -9012,12 +9035,6 @@ gfc_match_public (gfc_statement *st)
|
|||
return MATCH_ERROR;
|
||||
}
|
||||
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
{
|
||||
*st = ST_PUBLIC;
|
||||
return MATCH_YES;
|
||||
}
|
||||
|
||||
*st = ST_ATTR_DECL;
|
||||
return access_attr_decl (ST_PUBLIC);
|
||||
}
|
||||
|
|
|
|||
14
gcc/testsuite/gfortran.dg/pr90988_1.f90
Normal file
14
gcc/testsuite/gfortran.dg/pr90988_1.f90
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
! { dg-do compile }
|
||||
module mymod
|
||||
type :: mytyp
|
||||
integer :: i
|
||||
end type mytyp
|
||||
contains
|
||||
subroutine mysub
|
||||
implicit none
|
||||
type(mytyp) :: a
|
||||
integer :: publici,publicj
|
||||
publici = a%i
|
||||
publicj = a%j ! { dg-error "is not a member" }
|
||||
end subroutine mysub
|
||||
end module mymod
|
||||
14
gcc/testsuite/gfortran.dg/pr90988_2.f90
Normal file
14
gcc/testsuite/gfortran.dg/pr90988_2.f90
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
! { dg-do compile }
|
||||
module mymod
|
||||
type :: mytyp
|
||||
integer :: i
|
||||
end type mytyp
|
||||
contains
|
||||
subroutine mysub
|
||||
implicit none
|
||||
type(mytyp) :: a
|
||||
integer :: privatei,privatej
|
||||
privatei = a%i
|
||||
privatej = a%j ! { dg-error "is not a member" }
|
||||
end subroutine mysub
|
||||
end module mymod
|
||||
14
gcc/testsuite/gfortran.dg/pr90988_3.f90
Normal file
14
gcc/testsuite/gfortran.dg/pr90988_3.f90
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
! { dg-do compile }
|
||||
module mymod
|
||||
type :: mytyp
|
||||
integer :: i
|
||||
end type mytyp
|
||||
contains
|
||||
subroutine mysub
|
||||
implicit none
|
||||
type(mytyp) :: a
|
||||
integer :: protectedi,protectedj
|
||||
protectedi = a%i
|
||||
protectedj = a%j ! { dg-error "is not a member" }
|
||||
end subroutine mysub
|
||||
end module mymod
|
||||
Loading…
Add table
Reference in a new issue