Commit b4882698 by Steven G. Kargl

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
parent 07525dad
...@@ -8788,6 +8788,7 @@ access_attr_decl (gfc_statement st) ...@@ -8788,6 +8788,7 @@ access_attr_decl (gfc_statement st)
gfc_symbol *sym, *dt_sym; gfc_symbol *sym, *dt_sym;
gfc_intrinsic_op op; gfc_intrinsic_op op;
match m; match m;
gfc_access access = (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO) if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO)
goto done; goto done;
...@@ -8798,7 +8799,7 @@ access_attr_decl (gfc_statement st) ...@@ -8798,7 +8799,7 @@ access_attr_decl (gfc_statement st)
if (m == MATCH_NO) if (m == MATCH_NO)
goto syntax; goto syntax;
if (m == MATCH_ERROR) if (m == MATCH_ERROR)
return MATCH_ERROR; goto done;
switch (type) switch (type)
{ {
...@@ -8818,18 +8819,12 @@ access_attr_decl (gfc_statement st) ...@@ -8818,18 +8819,12 @@ access_attr_decl (gfc_statement st)
&& sym->attr.flavor == FL_UNKNOWN) && sym->attr.flavor == FL_UNKNOWN)
sym->attr.flavor = FL_PROCEDURE; sym->attr.flavor = FL_PROCEDURE;
if (!gfc_add_access (&sym->attr, if (!gfc_add_access (&sym->attr, access, sym->name, NULL))
(st == ST_PUBLIC) goto done;
? ACCESS_PUBLIC : ACCESS_PRIVATE,
sym->name, NULL))
return MATCH_ERROR;
if (sym->attr.generic && (dt_sym = gfc_find_dt_in_generic (sym)) if (sym->attr.generic && (dt_sym = gfc_find_dt_in_generic (sym))
&& !gfc_add_access (&dt_sym->attr, && !gfc_add_access (&dt_sym->attr, access, sym->name, NULL))
(st == ST_PUBLIC) goto done;
? ACCESS_PUBLIC : ACCESS_PRIVATE,
sym->name, NULL))
return MATCH_ERROR;
break; break;
...@@ -8838,17 +8833,14 @@ access_attr_decl (gfc_statement st) ...@@ -8838,17 +8833,14 @@ access_attr_decl (gfc_statement st)
{ {
gfc_intrinsic_op other_op; gfc_intrinsic_op other_op;
gfc_current_ns->operator_access[op] = gfc_current_ns->operator_access[op] = access;
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
/* Handle the case if there is another op with the same /* Handle the case if there is another op with the same
function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on. */ function, for INTRINSIC_EQ vs. INTRINSIC_EQ_OS and so on. */
other_op = gfc_equivalent_op (op); other_op = gfc_equivalent_op (op);
if (other_op != INTRINSIC_NONE) if (other_op != INTRINSIC_NONE)
gfc_current_ns->operator_access[other_op] = gfc_current_ns->operator_access[other_op] = access;
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
} }
else else
{ {
...@@ -8864,8 +8856,7 @@ access_attr_decl (gfc_statement st) ...@@ -8864,8 +8856,7 @@ access_attr_decl (gfc_statement st)
if (uop->access == ACCESS_UNKNOWN) if (uop->access == ACCESS_UNKNOWN)
{ {
uop->access = (st == ST_PUBLIC) uop->access = access;
? ACCESS_PUBLIC : ACCESS_PRIVATE;
} }
else else
{ {
...@@ -8898,6 +8889,13 @@ gfc_match_protected (void) ...@@ -8898,6 +8889,13 @@ gfc_match_protected (void)
{ {
gfc_symbol *sym; gfc_symbol *sym;
match m; 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 if (!gfc_current_ns->proc_name
|| gfc_current_ns->proc_name->attr.flavor != FL_MODULE) || gfc_current_ns->proc_name->attr.flavor != FL_MODULE)
...@@ -8908,14 +8906,12 @@ gfc_match_protected (void) ...@@ -8908,14 +8906,12 @@ gfc_match_protected (void)
} }
if (!gfc_notify_std (GFC_STD_F2003, "PROTECTED statement at %C")) gfc_match (" ::");
return MATCH_ERROR;
if (gfc_match (" ::") == MATCH_NO && gfc_match_space () == MATCH_NO) if (!gfc_notify_std (GFC_STD_F2003, "PROTECTED statement at %C"))
{
return MATCH_ERROR; return MATCH_ERROR;
}
/* PROTECTED has an entity-list. */
if (gfc_match_eos () == MATCH_YES) if (gfc_match_eos () == MATCH_YES)
goto syntax; goto syntax;
...@@ -8958,39 +8954,46 @@ syntax: ...@@ -8958,39 +8954,46 @@ syntax:
match match
gfc_match_private (gfc_statement *st) gfc_match_private (gfc_statement *st)
{ {
gfc_state_data *prev;
char c;
if (gfc_match ("private") != MATCH_YES) if (gfc_match ("private") != MATCH_YES)
return MATCH_NO; 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 if (gfc_current_state () != COMP_MODULE
&& !(gfc_current_state () == COMP_DERIVED && !(gfc_current_state () == COMP_DERIVED
&& gfc_state_stack->previous && prev && prev->state == COMP_MODULE)
&& gfc_state_stack->previous->state == COMP_MODULE)
&& !(gfc_current_state () == COMP_DERIVED_CONTAINS && !(gfc_current_state () == COMP_DERIVED_CONTAINS
&& gfc_state_stack->previous && gfc_state_stack->previous->previous && prev->previous && prev->previous->state == COMP_MODULE))
&& gfc_state_stack->previous->previous->state == COMP_MODULE))
{ {
gfc_error ("PRIVATE statement at %C is only allowed in the " gfc_error ("PRIVATE statement at %C is only allowed in the "
"specification part of a module"); "specification part of a module");
return MATCH_ERROR; return MATCH_ERROR;
} }
if (gfc_current_state () == COMP_DERIVED)
{
if (gfc_match_eos () == MATCH_YES)
{
*st = ST_PRIVATE; *st = ST_PRIVATE;
return MATCH_YES; return MATCH_YES;
} }
gfc_syntax_error (ST_PRIVATE); /* At this point, PRIVATE must be followed by whitespace or ::. */
return MATCH_ERROR; c = gfc_peek_ascii_char ();
} if (!gfc_is_whitespace (c) && c != ':')
return MATCH_NO;
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))
{ {
*st = ST_PRIVATE; gfc_error ("PRIVATE statement at %C is only allowed in the "
return MATCH_YES; "specification part of a module");
return MATCH_ERROR;
} }
*st = ST_ATTR_DECL; *st = ST_ATTR_DECL;
...@@ -9001,10 +9004,14 @@ gfc_match_private (gfc_statement *st) ...@@ -9001,10 +9004,14 @@ gfc_match_private (gfc_statement *st)
match match
gfc_match_public (gfc_statement *st) gfc_match_public (gfc_statement *st)
{ {
char c;
if (gfc_match ("public") != MATCH_YES) if (gfc_match ("public") != MATCH_YES)
return MATCH_NO; return MATCH_NO;
/* Try matching PUBLIC without an access-list. */
if (gfc_match_eos () == MATCH_YES)
{
if (gfc_current_state () != COMP_MODULE) if (gfc_current_state () != COMP_MODULE)
{ {
gfc_error ("PUBLIC statement at %C is only allowed in the " gfc_error ("PUBLIC statement at %C is only allowed in the "
...@@ -9012,12 +9019,22 @@ gfc_match_public (gfc_statement *st) ...@@ -9012,12 +9019,22 @@ gfc_match_public (gfc_statement *st)
return MATCH_ERROR; return MATCH_ERROR;
} }
if (gfc_match_eos () == MATCH_YES)
{
*st = ST_PUBLIC; *st = ST_PUBLIC;
return MATCH_YES; 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 "
"specification part of a module");
return MATCH_ERROR;
}
*st = ST_ATTR_DECL; *st = ST_ATTR_DECL;
return access_attr_decl (ST_PUBLIC); return access_attr_decl (ST_PUBLIC);
} }
......
! { 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
! { 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
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment