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

Fix, reorganize, and clarify comparisons of anonymous types/components. 

2016-08-29  Fritz Reese  <fritzoreese@gmail.com>

	Fix, reorganize, and clarify comparisons of anonymous types/components.

	PR fortran/77327
	* interface.c (is_anonymous_component, is_anonymous_dt): New functions.
	* interface.c (compare_components, gfc_compare_derived_types): Use new
	functions.

	* gfortran.dg/dec_structure_13.f90: New testcase.

From-SVN: r239819
This commit is contained in:
Fritz Reese 2016-08-29 12:24:25 +00:00 committed by Fritz Reese
parent 468d95c82c
commit 5f88e9b259
4 changed files with 133 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2016-08-29 Fritz Reese <fritzoreese@gmail.com>
Fix, reorganize, and clarify comparisons of anonymous types/components.
PR fortran/77327
* interface.c (is_anonymous_component, is_anonymous_dt): New functions.
* interface.c (compare_components, gfc_compare_derived_types): Use new
functions.
2016-08-27 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/77380

62
gcc/fortran/interface.c
View File

@ -387,26 +387,46 @@ gfc_match_end_interface (void)
}
/* Return whether the component was defined anonymously. */
static bool
is_anonymous_component (gfc_component *cmp)
{
/* Only UNION and MAP components are anonymous. In the case of a MAP,
the derived type symbol is FL_STRUCT and the component name looks like mM*.
This is the only case in which the second character of a component name is
uppercase. */
return cmp->ts.type == BT_UNION
|| (cmp->ts.type == BT_DERIVED
&& cmp->ts.u.derived->attr.flavor == FL_STRUCT
&& cmp->name[0] && cmp->name[1] && ISUPPER (cmp->name[1]));
}
/* Return whether the derived type was defined anonymously. */
static bool
is_anonymous_dt (gfc_symbol *derived)
{
/* UNION and MAP types are always anonymous. Otherwise, only nested STRUCTURE
types can be anonymous. For anonymous MAP/STRUCTURE, we have FL_STRUCT
and the type name looks like XX*. This is the only case in which the
second character of a type name is uppercase. */
return derived->attr.flavor == FL_UNION
|| (derived->attr.flavor == FL_STRUCT
&& derived->name[0] && derived->name[1] && ISUPPER (derived->name[1]));
}
/* Compare components according to 4.4.2 of the Fortran standard. */
static int
compare_components (gfc_component *cmp1, gfc_component *cmp2,
gfc_symbol *derived1, gfc_symbol *derived2)
{
gfc_symbol *d1, *d2;
bool anonymous = false;
/* Unions, maps, and anonymous structures all have names like "[xX]X$\d+"
which should not be compared. */
d1 = cmp1->ts.u.derived;
d2 = cmp2->ts.u.derived;
if ( (d1 && (d1->attr.flavor == FL_STRUCT || d1->attr.flavor == FL_UNION)
&& ISUPPER (cmp1->name[1]))
|| (d2 && (d2->attr.flavor == FL_STRUCT || d2->attr.flavor == FL_UNION)
&& ISUPPER (cmp2->name[1])))
anonymous = true;
if (!anonymous && strcmp (cmp1->name, cmp2->name) != 0)
/* Compare names, but not for anonymous components such as UNION or MAP. */
if (!is_anonymous_component (cmp1) && !is_anonymous_component (cmp2)
&& strcmp (cmp1->name, cmp2->name) != 0)
return 0;
if (cmp1->attr.access != cmp2->attr.access)
@ -512,22 +532,12 @@ int
gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
{
gfc_component *cmp1, *cmp2;
bool anonymous = false;
if (derived1 == derived2)
return 1;
gcc_assert (derived1 && derived2);
/* MAP and anonymous STRUCTURE types have internal names of the form
mM* and sS* (we can get away this this because source names are converted
to lowerase). Compare anonymous type names specially because each
gets a unique name when it is declared. */
anonymous = (derived1->name[0] == derived2->name[0]
&& derived1->name[1] && derived2->name[1] && derived2->name[2]
&& derived1->name[1] == (char) TOUPPER (derived1->name[0])
&& derived2->name[2] == (char) TOUPPER (derived2->name[0]));
/* Special case for comparing derived types across namespaces. If the
true names and module names are the same and the module name is
nonnull, then they are equal. */
@ -541,7 +551,9 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2)
because they can be anonymous; therefore two structures with different
names may be equal. */
if (strcmp (derived1->name, derived2->name) != 0 && !anonymous)
/* Compare names, but not for anonymous types such as UNION or MAP. */
if (!is_anonymous_dt (derived1) && !is_anonymous_dt (derived2)
&& strcmp (derived1->name, derived2->name) != 0)
return 0;
if (derived1->component_access == ACCESS_PRIVATE

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2016-08-29 Fritz Reese <fritzoreese@gmail.com>
Fix, reorganize, and clarify comparisons of anonymous types/components.
* gfortran.dg/dec_structure_13.f90: New testcase.
2016-08-29 Janne Blomqvist <jb@gcc.gnu.org>
PR fortran/77261

81
gcc/testsuite/gfortran.dg/dec_structure_13.f90 Normal file
View File

@ -0,0 +1,81 @@
! { dg-do compile }
! { dg-options "-fdec-structure" }
!
! Verify that the comparisons in gfc_compare_derived_types can correctly
! match nested anonymous subtypes.
!
subroutine sub0 (u)
structure /t/
structure sub
integer i
end structure
endstructure
record /t/ u
u.sub.i = 0
end subroutine sub0
subroutine sub1 ()
structure /t/
structure sub
integer i
end structure
endstructure
record /t/ u
interface
subroutine sub0 (u) ! regression: Interface mismatch.*Type mismatch
structure /t/
structure sub
integer i
end structure
endstructure
record /t/ u
end subroutine
end interface
call sub0(u) ! regression: Type mismatch in argument
end subroutine
subroutine sub2(u)
structure /tu/
union
map
integer i
end map
map
real r
end map
end union
end structure
record /tu/ u
u.r = 1.0
end subroutine
implicit none
structure /t/
structure sub
integer i
end structure
endstructure
structure /tu/
union
map
integer i
end map
map
real r
end map
end union
end structure
record /t/ u
record /tu/ u2
call sub0(u) ! regression: Type mismatch in argument
call sub1()
call sub2(u2)
end