re PR fortran/82865 (Option -fdec collides with PDT)
2018-06-28 Fritz Reese <fritzoreese@gmail.com> gcc/fortran/ChangeLog: PR fortran/82865 * decl.c (gfc_match_type): Refactor and check for PDT declarations. gcc/testsuite/ChangeLog: PR fortran/82865 * gfortran.dg/dec_type_print_2.f03: New testcase. From-SVN: r262221
This commit is contained in:
parent
29b54a9d2d
commit
58b9de9ef5
|
@ -1,3 +1,8 @@
|
|||
2018-06-28 Fritz Reese <fritzoreese@gmail.com>
|
||||
|
||||
PR fortran/82865
|
||||
* decl.c (gfc_match_type): Refactor and check for PDT declarations.
|
||||
|
||||
2018-06-28 Martin Liska <mliska@suse.cz>
|
||||
|
||||
* gfortranspec.c: Include opt-suggestions.h.
|
||||
|
|
|
@ -9803,9 +9803,9 @@ gfc_match_structure_decl (void)
|
|||
|
||||
|
||||
/* This function does some work to determine which matcher should be used to
|
||||
* match a statement beginning with "TYPE". This is used to disambiguate TYPE
|
||||
* match a statement beginning with "TYPE". This is used to disambiguate TYPE
|
||||
* as an alias for PRINT from derived type declarations, TYPE IS statements,
|
||||
* and derived type data declarations. */
|
||||
* and [parameterized] derived type declarations. */
|
||||
|
||||
match
|
||||
gfc_match_type (gfc_statement *st)
|
||||
|
@ -9832,11 +9832,7 @@ gfc_match_type (gfc_statement *st)
|
|||
/* If we see an attribute list before anything else it's definitely a derived
|
||||
* type declaration. */
|
||||
if (gfc_match (" ,") == MATCH_YES || gfc_match (" ::") == MATCH_YES)
|
||||
{
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_DERIVED_DECL;
|
||||
return gfc_match_derived_decl ();
|
||||
}
|
||||
goto derived;
|
||||
|
||||
/* By now "TYPE" has already been matched. If we do not see a name, this may
|
||||
* be something like "TYPE *" or "TYPE <fmt>". */
|
||||
|
@ -9851,29 +9847,11 @@ gfc_match_type (gfc_statement *st)
|
|||
*st = ST_WRITE;
|
||||
return MATCH_YES;
|
||||
}
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_DERIVED_DECL;
|
||||
return gfc_match_derived_decl ();
|
||||
goto derived;
|
||||
}
|
||||
|
||||
/* A derived type declaration requires an EOS. Without it, assume print. */
|
||||
m = gfc_match_eos ();
|
||||
if (m == MATCH_NO)
|
||||
{
|
||||
/* Check manually for TYPE IS (... - this is invalid print syntax. */
|
||||
if (strncmp ("is", name, 3) == 0
|
||||
&& gfc_match (" (", name) == MATCH_YES)
|
||||
{
|
||||
gfc_current_locus = old_loc;
|
||||
gcc_assert (gfc_match (" is") == MATCH_YES);
|
||||
*st = ST_TYPE_IS;
|
||||
return gfc_match_type_is ();
|
||||
}
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_WRITE;
|
||||
return gfc_match_print ();
|
||||
}
|
||||
else
|
||||
/* Check for EOS. */
|
||||
if (gfc_match_eos () == MATCH_YES)
|
||||
{
|
||||
/* By now we have "TYPE <name> <EOS>". Check first if the name is an
|
||||
* intrinsic typename - if so let gfc_match_derived_decl dump an error.
|
||||
|
@ -9886,12 +9864,36 @@ gfc_match_type (gfc_statement *st)
|
|||
*st = ST_DERIVED_DECL;
|
||||
return m;
|
||||
}
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_WRITE;
|
||||
return gfc_match_print ();
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Here we have "TYPE <name>". Check for <TYPE IS (> or a PDT declaration
|
||||
like <type name(parameter)>. */
|
||||
gfc_gobble_whitespace ();
|
||||
bool paren = gfc_peek_ascii_char () == '(';
|
||||
if (paren)
|
||||
{
|
||||
if (strcmp ("is", name) == 0)
|
||||
goto typeis;
|
||||
else
|
||||
goto derived;
|
||||
}
|
||||
}
|
||||
|
||||
return MATCH_NO;
|
||||
/* Treat TYPE... like PRINT... */
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_WRITE;
|
||||
return gfc_match_print ();
|
||||
|
||||
derived:
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_DERIVED_DECL;
|
||||
return gfc_match_derived_decl ();
|
||||
|
||||
typeis:
|
||||
gfc_current_locus = old_loc;
|
||||
*st = ST_TYPE_IS;
|
||||
return gfc_match_type_is ();
|
||||
}
|
||||
|
||||
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2018-06-28 Fritz Reese <fritzoreese@gmail.com>
|
||||
|
||||
PR fortran/82865
|
||||
* gfortran.dg/dec_type_print_2.f03: New testcase.
|
||||
|
||||
2018-06-28 David Pagan <dave.pagan@oracle.com>
|
||||
|
||||
PR c/55976
|
||||
|
|
|
@ -0,0 +1,59 @@
|
|||
! { dg-do run }
|
||||
! { dg-options "-fdec -fcheck=all" }
|
||||
!
|
||||
! Verify that -fdec does not break parsing of PDTs.
|
||||
! This test code is copied from pdt_1.f03 but compiled with -fdec.
|
||||
!
|
||||
program main
|
||||
implicit none
|
||||
integer, parameter :: ftype = kind(0.0e0)
|
||||
integer :: pdt_len = 4
|
||||
integer :: i
|
||||
type :: mytype (a,b)
|
||||
integer, kind :: a = kind(0.0d0)
|
||||
integer, LEN :: b
|
||||
integer :: i
|
||||
real(kind = a) :: d(b, b)
|
||||
character (len = b*b) :: chr
|
||||
end type
|
||||
|
||||
type(mytype(b=4)) :: z(2)
|
||||
type(mytype(ftype, 4)) :: z2
|
||||
|
||||
z(1)%i = 1
|
||||
z(2)%i = 2
|
||||
z(1)%d = reshape ([(real(i), i = 1, 16)],[4,4])
|
||||
z(2)%d = 10*z(1)%d
|
||||
z(1)%chr = "hello pdt"
|
||||
z(2)%chr = "goodbye pdt"
|
||||
|
||||
z2%d = z(1)%d * 10 - 1
|
||||
z2%chr = "scalar pdt"
|
||||
|
||||
call foo (z)
|
||||
call bar (z)
|
||||
call foobar (z2)
|
||||
contains
|
||||
elemental subroutine foo (arg)
|
||||
type(mytype(8,*)), intent(in) :: arg
|
||||
if (arg%i .eq. 1) then
|
||||
if (trim (arg%chr) .ne. "hello pdt") error stop
|
||||
if (int (sum (arg%d)) .ne. 136) error stop
|
||||
else if (arg%i .eq. 2 ) then
|
||||
if (trim (arg%chr) .ne. "goodbye pdt") error stop
|
||||
if (int (sum (arg%d)) .ne. 1360) error stop
|
||||
else
|
||||
error stop
|
||||
end if
|
||||
end subroutine
|
||||
subroutine bar (arg)
|
||||
type(mytype(b=4)) :: arg(:)
|
||||
if (int (sum (arg(1)%d)) .ne. 136) call abort
|
||||
if (trim (arg(2)%chr) .ne. "goodbye pdt") call abort
|
||||
end subroutine
|
||||
subroutine foobar (arg)
|
||||
type(mytype(ftype, pdt_len)) :: arg
|
||||
if (int (sum (arg%d)) .ne. 1344) call abort
|
||||
if (trim (arg%chr) .ne. "scalar pdt") call abort
|
||||
end subroutine
|
||||
end
|
Loading…
Reference in New Issue