This patch fixes PR96325. See the explanatory comment in the testcase.

2020-08-02  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/96325
	* primary.c (gfc_match_varspec): In the case that a component
	reference is added to an intrinsic type component, emit the
	error message in this function.

gcc/testsuite/
	PR fortran/96325
	* gfortran.dg/pr96325.f90: New test.
	* gfortran.dg/pr91589.f90: Update error message.
This commit is contained in:
Paul Thomas 2020-08-02 10:35:36 +01:00
parent 4967ca2f8b
commit e41da82345
3 changed files with 31 additions and 5 deletions

View File

@ -2023,7 +2023,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_ref *substring, *tail, *tmp;
gfc_component *component;
gfc_component *component = NULL;
gfc_component *previous = NULL;
gfc_symbol *sym = primary->symtree->n.sym;
gfc_expr *tgt_expr = NULL;
match m;
@ -2343,15 +2344,19 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
break;
}
previous = component;
if (!inquiry && !intrinsic)
component = gfc_find_component (sym, name, false, false, &tmp);
else
component = NULL;
/* In some cases, returning MATCH_NO gives a better error message. Most
cases return "Unclassifiable statement at..." */
if (intrinsic && !inquiry)
return MATCH_NO;
{
gfc_error ("%qs at %C is not an inquiry reference to an intrinsic "
"type component %qs", name, previous->name);
return MATCH_ERROR;
}
else if (component == NULL && !inquiry)
return MATCH_ERROR;

View File

@ -10,6 +10,6 @@ program p
integer :: a
end type
type(t) :: x = t(1)
call sub (x%a%a) ! { dg-error "Syntax error in argument list" }
call sub (x%a%a) ! { dg-error "is not an inquiry reference" }
end

View File

@ -0,0 +1,21 @@
! { dg-do run }
!
! Test the fix for PR96325 in which the typebound procedure reference
! 'foo' was applied to an intrinsic type component without generating
! an error. The result of the expression was the value of the arg..
!
! Contributed by Gerhardt Steinmetz <gscfq@t-online.de>
!
implicit none
type t2
integer r1
end type
type(t2) :: t
integer :: a
a = t%r1%foo(1) { dg-error "is not an inquiry reference" }
if (a == 42) stop
end