diff options
Diffstat (limited to 'gcc/ada/a-cimutr.adb')
| -rw-r--r-- | gcc/ada/a-cimutr.adb | 45 |
1 files changed, 41 insertions, 4 deletions
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb index 050c0395dee..4ca89ca11ab 100644 --- a/gcc/ada/a-cimutr.adb +++ b/gcc/ada/a-cimutr.adb @@ -291,7 +291,17 @@ package body Ada.Containers.Indefinite_Multiway_Trees is with "attempt to tamper with cursors (tree is busy)"; end if; - Element := new Element_Type'(New_Item); + declare + pragma Unsuppress (Accessibility_Check); + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the + -- allocator in the loop below, because the one in this block would + -- have failed already. + begin + Element := new Element_Type'(New_Item); + end; + First := new Tree_Node_Type'(Parent => Parent.Node, Element => Element, others => <>); @@ -1240,7 +1250,17 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Position.Container := Parent.Container; - Element := new Element_Type'(New_Item); + declare + pragma Unsuppress (Accessibility_Check); + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the + -- allocator in the loop below, because the one in this block would + -- have failed already. + begin + Element := new Element_Type'(New_Item); + end; + Position.Node := new Tree_Node_Type'(Parent => Parent.Node, Element => Element, others => <>); @@ -1805,7 +1825,17 @@ package body Ada.Containers.Indefinite_Multiway_Trees is with "attempt to tamper with cursors (tree is busy)"; end if; - Element := new Element_Type'(New_Item); + declare + pragma Unsuppress (Accessibility_Check); + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). We don't unsuppress the check on the + -- allocator in the loop below, because the one in this block would + -- have failed already. + begin + Element := new Element_Type'(New_Item); + end; + First := new Tree_Node_Type'(Parent => Parent.Node, Element => Element, others => <>); @@ -2163,7 +2193,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is with "attempt to tamper with elements (tree is locked)"; end if; - E := new Element_Type'(New_Item); + declare + pragma Unsuppress (Accessibility_Check); + -- The element allocator may need an accessibility check in the case + -- the actual type is class-wide or has access discriminants (see + -- RM 4.8(10.1) and AI12-0035). + begin + E := new Element_Type'(New_Item); + end; X := Position.Node.Element; Position.Node.Element := E; |