diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/ada/a-cidlli.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/a-cihama.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/a-cihase.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/a-cimutr.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/a-ciorma.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/a-ciormu.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/a-ciorse.adb | 29 | ||||
| -rw-r--r-- | gcc/ada/a-coinho.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/a-coinve.adb | 33 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_ch7.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/par-ch13.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/par_sco.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/s-tasinf-linux.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 12 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_ch9.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/sem_dim.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 4 |
23 files changed, 201 insertions, 105 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c87a44459db..19dbf07fa6b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2012-07-30 Robert Dewar <dewar@adacore.com> + + * par_sco.adb, a-cihama.adb, a-coinve.adb, exp_ch7.adb, a-ciorse.adb, + exp_ch9.adb, sem_dim.adb, par-ch13.adb, sem_ch9.adb, a-cidlli.adb, + a-cimutr.adb, freeze.adb, a-ciormu.adb, sem_res.adb, sem_attr.adb, + a-cihase.adb, exp_ch4.adb, sem_ch4.adb, a-ciorma.adb, + s-tasinf-linux.ads, sem_ch13.adb, a-coinho.adb: Minor reformatting. + Add comments. + 2012-07-30 Vincent Pucci <pucci@adacore.com> * sem_ch9.adb (Allows_Lock_Free_Implementation): Restrict implicit diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index 12a825a8d21..fafe6719170 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -888,16 +888,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is end if; 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. + pragma Unsuppress (Accessibility_Check); + Element : Element_Access := new Element_Type'(New_Item); + begin New_Node := new Node_Type'(Element, null, null); + exception when others => Free (Element); @@ -1468,12 +1471,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is pragma Assert (Vet (Position), "bad cursor in Replace_Element"); 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). + pragma Unsuppress (Accessibility_Check); + X : Element_Access := Position.Node.Element; + begin Position.Node.Element := new Element_Type'(New_Item); Free (X); diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index 3f5b7ec5bd8..2ea73b9f960 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -695,12 +695,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is Position.Node.Key := new Key_Type'(Key); 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). + + pragma Unsuppress (Accessibility_Check); + begin Position.Node.Element := new Element_Type'(New_Item); + exception when others => Free_Key (K); @@ -736,14 +739,16 @@ package body Ada.Containers.Indefinite_Hashed_Maps is K : Key_Access := new Key_Type'(Key); E : Element_Access; - 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). + pragma Unsuppress (Accessibility_Check); + begin E := new Element_Type'(New_Item); return new Node_Type'(K, E, Next); + exception when others => Free_Key (K); @@ -1177,12 +1182,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is Node.Key := new Key_Type'(Key); 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(New_Item); + exception when others => Free_Key (K); @@ -1230,10 +1238,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is declare X : Element_Access := Position.Node.Element; - 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). + + pragma Unsuppress (Accessibility_Check); + begin Position.Node.Element := new Element_Type'(New_Item); Free_Element (X); diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb index 034cfce67ec..9d96b6c6452 100644 --- a/gcc/ada/a-cihase.adb +++ b/gcc/ada/a-cihase.adb @@ -186,10 +186,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is procedure Assign (Node : Node_Access; Item : Element_Type) is X : Element_Access := Node.Element; - 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 (RM 4.8(10.1) -- and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); Free_Element (X); @@ -199,10 +201,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is begin if Target'Address = Source'Address then return; + else + Target.Clear; + Target.Union (Source); end if; - - Target.Clear; - Target.Union (Source); end Assign; -------------- @@ -813,10 +815,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is X := Position.Node.Element; 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). + + pragma Unsuppress (Accessibility_Check); + begin Position.Node.Element := new Element_Type'(New_Item); end; @@ -875,14 +879,18 @@ package body Ada.Containers.Indefinite_Hashed_Sets is -------------- function New_Node (Next : Node_Access) return Node_Access is - 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). + pragma Unsuppress (Accessibility_Check); + Element : Element_Access := new Element_Type'(New_Item); + begin return new Node_Type'(Element, Next); + exception when others => Free_Element (Element); @@ -898,9 +906,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Local_Insert (HT, New_Item, Node, Inserted); - if Inserted - and then HT.Length > HT_Ops.Capacity (HT) - then + if Inserted and then HT.Length > HT_Ops.Capacity (HT) then HT_Ops.Reserve_Capacity (HT, HT.Length); end if; end Insert; @@ -1335,10 +1341,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is X := Node.Element; 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(New_Item); end; diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb index 4ca89ca11ab..e249c6a68d6 100644 --- a/gcc/ada/a-cimutr.adb +++ b/gcc/ada/a-cimutr.adb @@ -292,12 +292,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is end if; 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. + + pragma Unsuppress (Accessibility_Check); + begin Element := new Element_Type'(New_Item); end; @@ -1251,12 +1253,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is Position.Container := Parent.Container; 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. + + pragma Unsuppress (Accessibility_Check); + begin Element := new Element_Type'(New_Item); end; @@ -1826,12 +1830,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is end if; 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. + + pragma Unsuppress (Accessibility_Check); + begin Element := new Element_Type'(New_Item); end; @@ -2194,10 +2200,12 @@ package body Ada.Containers.Indefinite_Multiway_Trees is end if; 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). + + pragma Unsuppress (Accessibility_Check); + begin E := new Element_Type'(New_Item); end; diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index 15e0835db44..472c912d27b 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -813,12 +813,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position.Node.Key := new Key_Type'(Key); 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). + + pragma Unsuppress (Accessibility_Check); + begin Position.Node.Element := new Element_Type'(New_Item); + exception when others => Free_Key (K); @@ -857,10 +860,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function New_Node return Node_Access is Node : Node_Access := new Node_Type; - 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Key := new Key_Type'(Key); Node.Element := new Element_Type'(New_Item); @@ -869,9 +874,10 @@ package body Ada.Containers.Indefinite_Ordered_Maps is exception when others => - -- On exception, deallocate key and elem + -- On exception, deallocate key and elem. Note that free + -- deallocates both the key and the elem. - Free (Node); -- Note that Free deallocates key and elem too + Free (Node); raise; end New_Node; @@ -1502,12 +1508,15 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Node.Key := new Key_Type'(Key); 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(New_Item); + exception when others => Free_Key (K); @@ -1556,10 +1565,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is declare X : Element_Access := Position.Node.Element; - 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). + + pragma Unsuppress (Accessibility_Check); + begin Position.Node.Element := new Element_Type'(New_Item); Free_Element (X); diff --git a/gcc/ada/a-ciormu.adb b/gcc/ada/a-ciormu.adb index b7dd81a752a..7bd1aa1e557 100644 --- a/gcc/ada/a-ciormu.adb +++ b/gcc/ada/a-ciormu.adb @@ -1167,11 +1167,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is -------------- function New_Node return Node_Access is - 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). + pragma Unsuppress (Accessibility_Check); + Element : Element_Access := new Element_Type'(New_Item); begin @@ -1180,6 +1181,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is Right => null, Color => Red_Black_Trees.Red, Element => Element); + exception when others => Free_Element (Element); @@ -1774,10 +1776,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is declare X : Element_Access := Node.Element; - 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); Free_Element (X); @@ -1803,10 +1807,13 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is -------------- function New_Node return Node_Access is - 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); -- OK if fails Node.Color := Red_Black_Trees.Red; diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb index 3eca4c79842..885c6b6568b 100644 --- a/gcc/ada/a-ciorse.adb +++ b/gcc/ada/a-ciorse.adb @@ -1174,10 +1174,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end if; 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). + + pragma Unsuppress (Accessibility_Check); + begin X := Position.Node.Element; Position.Node.Element := new Element_Type'(New_Item); @@ -1245,11 +1247,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -------------- function New_Node return Node_Access is - 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). + pragma Unsuppress (Accessibility_Check); + Element : Element_Access := new Element_Type'(New_Item); begin @@ -1258,6 +1261,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is Right => null, Color => Red_Black_Trees.Red, Element => Element); + exception when others => Free_Element (Element); @@ -1831,10 +1835,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end if; 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). + + pragma Unsuppress (Accessibility_Check); + begin X := Node.Element; Node.Element := new Element_Type'(New_Item); @@ -1873,10 +1879,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -------------- function New_Node return Node_Access is - 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); -- OK if fails Node.Color := Red; @@ -1895,9 +1904,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is -- Start of processing for Replace_Element begin - if Item < Node.Element.all - or else Node.Element.all < Item - then + if Item < Node.Element.all or else Node.Element.all < Item then null; else @@ -1907,10 +1914,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end if; 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). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); Free_Element (X); @@ -1932,10 +1941,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is end if; declare - pragma Unsuppress (Accessibility_Check); -- The element allocator may need an accessibility check in the -- case actual type is class-wide or has access discriminants -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Node.Element := new Element_Type'(Item); Free_Element (X); diff --git a/gcc/ada/a-coinho.adb b/gcc/ada/a-coinho.adb index 16334e28d17..0d0d40064e9 100644 --- a/gcc/ada/a-coinho.adb +++ b/gcc/ada/a-coinho.adb @@ -223,10 +223,12 @@ package body Ada.Containers.Indefinite_Holders is declare X : Element_Access := Container.Element; - pragma Unsuppress (Accessibility_Check); -- Element allocator may need an accessibility check in case actual -- type is class-wide or has access discriminants (RM 4.8(10.1) and -- AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Container.Element := new Element_Type'(New_Item); Free (X); @@ -238,10 +240,12 @@ package body Ada.Containers.Indefinite_Holders is --------------- function To_Holder (New_Item : Element_Type) return Holder is - 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 (RM 4.8(10.1) -- and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin return (AF.Controlled with new Element_Type'(New_Item), 0); end To_Holder; diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 750b5b0540e..e615ad17efd 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -1699,10 +1699,12 @@ package body Ada.Containers.Indefinite_Vectors is -- storage available, or because element initialization fails). declare - pragma Unsuppress (Accessibility_Check); -- The element allocator may need an accessibility check in the -- case actual type is class-wide or has access discriminants -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Container.Elements.EA (Idx) := new Element_Type'(New_Item); end; @@ -1752,10 +1754,12 @@ package body Ada.Containers.Indefinite_Vectors is -- initialization fails). declare - pragma Unsuppress (Accessibility_Check); -- The element allocator may need an accessibility check -- in case the actual type is class-wide or has access -- discriminants (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin E (Idx) := new Element_Type'(New_Item); end; @@ -1794,11 +1798,14 @@ package body Ada.Containers.Indefinite_Vectors is -- K always has a value if the exception handler triggers. K := Before; + 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). + + pragma Unsuppress (Accessibility_Check); + begin while K < Index loop E (K) := new Element_Type'(New_Item); @@ -1905,10 +1912,12 @@ package body Ada.Containers.Indefinite_Vectors is -- initialization fails). 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). + + pragma Unsuppress (Accessibility_Check); + begin Dst.EA (Idx) := new Element_Type'(New_Item); end; @@ -1952,10 +1961,12 @@ package body Ada.Containers.Indefinite_Vectors is -- let it propagate. 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). + + pragma Unsuppress (Accessibility_Check); + begin Dst.EA (Idx) := new Element_Type'(New_Item); end; @@ -3208,10 +3219,12 @@ package body Ada.Containers.Indefinite_Vectors is declare X : Element_Access := Container.Elements.EA (Index); - pragma Unsuppress (Accessibility_Check); -- The element allocator may need an accessibility check in the case -- where the actual type is class-wide or has access discriminants -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Container.Elements.EA (Index) := new Element_Type'(New_Item); Free (X); @@ -3244,10 +3257,12 @@ package body Ada.Containers.Indefinite_Vectors is declare X : Element_Access := Container.Elements.EA (Position.Index); - pragma Unsuppress (Accessibility_Check); -- The element allocator may need an accessibility check in the case -- where the actual type is class-wide or has access discriminants -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin Container.Elements.EA (Position.Index) := new Element_Type'(New_Item); Free (X); @@ -3993,10 +4008,12 @@ package body Ada.Containers.Indefinite_Vectors is Last := Index_Type'First; declare - pragma Unsuppress (Accessibility_Check); -- The element allocator may need an accessibility check in the case -- where the actual type is class-wide or has access discriminants -- (see RM 4.8(10.1) and AI12-0035). + + pragma Unsuppress (Accessibility_Check); + begin loop Elements.EA (Last) := new Element_Type'(New_Item); diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index e0b344164bf..9ac910cede0 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -705,8 +705,7 @@ package body Exp_Ch4 is or else (Is_Class_Wide_Type (Etype (Exp)) and then Scope (PtrT) /= Current_Scope)) - and then - (Tagged_Type_Expansion or else VM_Target /= No_VM) + and then (Tagged_Type_Expansion or else VM_Target /= No_VM) then -- If the allocator was built in place, Ref is already a reference -- to the access object initialized to the result of the allocator diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 17ad11cc173..2839bf39e56 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -4568,6 +4568,9 @@ package body Exp_Ch7 is -- finalization blocks, and we put everything into a wrapper -- block to clearly expose the construct to the back-end. + -- This requirement for "clearly expose" must be properly + -- documented in sinfo/einfo ??? + if Present (Prev_Fin) then Insert_Before_And_Analyze (Prev_Fin, Fin_Block); else diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index a8bca192a82..53ff97e343f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -5485,6 +5485,7 @@ package body Exp_Ch9 is procedure Ensure_Statement_Present (Loc : Source_Ptr; Alt : Node_Id) is Stmt : Node_Id; + begin if Opt.Suppress_Control_Flow_Optimizations and then Is_Empty_List (Statements (Alt)) @@ -5494,6 +5495,9 @@ package body Exp_Ch9 is -- Mark NULL statement as coming from source so that it is not -- eliminated by GIGI. + -- Another covert channel! If this is a requirement, it must be + -- documented in sinfo/einfo ??? + Set_Comes_From_Source (Stmt, True); Set_Statements (Alt, New_List (Stmt)); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 14856432ca9..f2f7ac918c8 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3029,7 +3029,7 @@ package body Freeze is -- Pre/post conditions are implemented through a subprogram in -- the corresponding body, and therefore are not checked on an - -- imported subprogram, for which the body is not available. + -- imported subprogram for which the body is not available. -- Could consider generating a wrapper to take care of this??? diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb index 2a257f5d7de..030f929a7b7 100644 --- a/gcc/ada/par-ch13.adb +++ b/gcc/ada/par-ch13.adb @@ -645,7 +645,6 @@ package body Ch13 is Ptr : Source_Ptr; begin - -- Aspect Specification is present Ptr := Token_Ptr; @@ -834,11 +833,10 @@ package body Ch13 is -- Otherwise we have an illegal range attribute. Note that P_Name -- ensures that Token = Tok_Range is the only possibility left here. - else -- Token = Tok_Range + else Error_Msg_SC ("RANGE attribute illegal here!"); raise Error_Resync; end if; - end P_Code_Statement; end Ch13; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index fd1d887284f..73b00c24ee9 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -492,13 +492,16 @@ package body Par_SCO is -- For entry guard, the token sloc is from the N_Entry_Body. -- For PRAGMA, we must get the location from the pragma node. - -- Argument N is the pragma argument, and we have to go up two - -- levels (through the pragma argument association) to get to - -- the pragma node itself. For the guard on a select - -- alternative, we do not have access to the token location - -- for the WHEN, so we use the first sloc of the condition - -- itself (note: we use First_Sloc, not Sloc, because this is - -- what is referenced by dominance markers). + -- Argument N is the pragma argument, and we have to go up + -- two levels (through the pragma argument association) to + -- get to the pragma node itself. For the guard on a select + -- alternative, we do not have access to the token location for + -- the WHEN, so we use the first sloc of the condition itself + -- (note: we use First_Sloc, not Sloc, because this is what is + -- referenced by dominance markers). + + -- Doesn't this requirement of using First_Sloc need to be + -- documented in the spec ??? if Nkind_In (Parent (N), N_Accept_Alternative, N_Delay_Alternative, diff --git a/gcc/ada/s-tasinf-linux.ads b/gcc/ada/s-tasinf-linux.ads index b789dd1cf60..740c6bb3646 100644 --- a/gcc/ada/s-tasinf-linux.ads +++ b/gcc/ada/s-tasinf-linux.ads @@ -48,10 +48,10 @@ package System.Task_Info is pragma Elaborate_Body; -- To ensure that a body is allowed - -- Linux provides a way to define the ideal processor to use for a given - -- thread. The ideal processor is not necessarily the one that will be used - -- by the OS but the OS will always try to schedule this thread to the - -- specified processor if it is available. + -- The Linux kernel provides a way to define the ideal processor to use for + -- a given thread. The ideal processor is not necessarily the one that will + -- be used by the OS but the OS will always try to schedule this thread to + -- the specified processor if it is available. -- The Task_Info pragma: diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index e1abe5a048d..782cd984fde 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4029,10 +4029,10 @@ package body Sem_Attr is -- within the subprogram itself. If the prefix includes a function -- call it may involve finalization actions that should only be -- inserted when the attribute has been rewritten as a declarations. - -- As a result, if the prefix is not a simple name we create a - -- declaration for it now, and insert it at the start of the - -- enclosing subprogram. This is properly an expansion activity but - -- it has to be performed now to prevent out-of-order issues. + -- As a result, if the prefix is not a simple name we create + -- a declaration for it now, and insert it at the start of the + -- enclosing subprogram. This is properly an expansion activity + -- but it has to be performed now to prevent out-of-order issues. if not Is_Entity_Name (P) then P_Type := Base_Type (P_Type); @@ -4474,9 +4474,9 @@ package body Sem_Attr is Check_Decimal_Fixed_Point_Type; Set_Etype (N, P_Base_Type); - -- Because the context is universal_real (3.5.10(12)) it is a legal - -- context for a universal fixed expression. This is the only - -- attribute whose functional description involves U_R. + -- Because the context is universal_real (3.5.10(12)) it is a + -- legal context for a universal fixed expression. This is the + -- only attribute whose functional description involves U_R. if Etype (E1) = Universal_Fixed then declare @@ -4771,8 +4771,8 @@ package body Sem_Attr is Validate_Remote_Access_To_Class_Wide_Type (N); - -- The prefix is allowed to be an implicit dereference - -- of an access value designating a task. + -- The prefix is allowed to be an implicit dereference of an + -- access value designating a task. else Check_Task_Prefix; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index df61549e137..82ef7298ffa 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -1866,8 +1866,8 @@ package body Sem_Ch13 is Chars => Name_Address, Expression => Expression (N))); - -- We preserve Comes_From_Source, since logically the clause still - -- comes from the source program even though it is changed in form. + -- We preserve Comes_From_Source, since logically the clause still comes + -- from the source program even though it is changed in form. Set_Comes_From_Source (N, CS); @@ -2685,8 +2685,8 @@ package body Sem_Ch13 is -- Legality checks on the address clause for initialized -- objects is deferred until the freeze point, because - -- a subsequent pragma might indicate that the object is - -- imported and thus not initialized. + -- a subsequent pragma might indicate that the object + -- is imported and thus not initialized. Set_Has_Delayed_Freeze (U_Ent); @@ -3120,8 +3120,8 @@ package body Sem_Ch13 is when Attribute_Implicit_Dereference => - -- Legality checks already performed at the point of - -- the type declaration, aspect is not delayed. + -- Legality checks already performed at the point of the type + -- declaration, aspect is not delayed. null; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ed046f45820..04305784f6e 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4231,8 +4231,9 @@ package body Sem_Ch4 is begin Set_Parent (Par, Parent (Parent (N))); + if Try_Object_Operation - (Sinfo.Name (Par), CW_Test_Only => True) + (Sinfo.Name (Par), CW_Test_Only => True) then return; end if; @@ -6531,7 +6532,6 @@ package body Sem_Ch4 is declare Arg : Node_Id; - begin Arg := First (Exprs); while Present (Arg) loop @@ -6542,9 +6542,10 @@ package body Sem_Ch4 is if not Is_Overloaded (Func_Name) then Func := Entity (Func_Name); - Indexing := Make_Function_Call (Loc, - Name => New_Occurrence_Of (Func, Loc), - Parameter_Associations => Assoc); + Indexing := + Make_Function_Call (Loc, + Name => New_Occurrence_Of (Func, Loc), + Parameter_Associations => Assoc); Rewrite (N, Indexing); Analyze (N); @@ -6609,8 +6610,8 @@ package body Sem_Ch4 is end if; if Etype (N) = Any_Type then - Error_Msg_NE ("container cannot be indexed with&", - N, Etype (First (Exprs))); + Error_Msg_NE + ("container cannot be indexed with&", N, Etype (First (Exprs))); Rewrite (N, New_Occurrence_Of (Any_Id, Loc)); else Analyze (N); diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index c392dccdc9a..877ac4d0f38 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -68,7 +68,7 @@ package body Sem_Ch9 is ----------------------- function Allows_Lock_Free_Implementation - (N : Node_Id; + (N : Node_Id; Lock_Free_Given : Boolean := False) return Boolean; -- This routine returns True iff N satisfies the following list of lock- -- free restrictions for protected type declaration and protected body: @@ -130,9 +130,8 @@ package body Sem_Ch9 is -- when Lock_Free_Given is True. begin - pragma Assert (Nkind_In (N, - N_Protected_Type_Declaration, - N_Protected_Body)); + pragma Assert (Nkind_In (N, N_Protected_Type_Declaration, + N_Protected_Body)); -- The lock-free implementation is currently enabled through a debug -- flag. When Lock_Free_Given is True, an aspect Lock_Free forces the @@ -418,8 +417,8 @@ package body Sem_Ch9 is and then Is_Access_Type (Etype (Prefix (N)))) then if Lock_Free_Given then - Error_Msg_N ("dereference of access value " & - "not allowed", N); + Error_Msg_N + ("dereference of access value not allowed", N); return Skip; end if; @@ -431,8 +430,8 @@ package body Sem_Ch9 is and then not Is_Static_Expression (N) then if Lock_Free_Given then - Error_Msg_N ("non-static function call not allowed", - N); + Error_Msg_N + ("non-static function call not allowed", N); return Skip; end if; @@ -463,10 +462,12 @@ package body Sem_Ch9 is -- outside the protected subprogram scope. if Ekind (Id) in Assignable_Kind - and then not Scope_Within_Or_Same (Scope (Id), - Sub_Id) - and then not Scope_Within_Or_Same (Scope (Id), - Protected_Body_Subprogram (Sub_Id)) + and then not + Scope_Within_Or_Same (Scope (Id), Sub_Id) + and then not + Scope_Within_Or_Same + (Scope (Id), + Protected_Body_Subprogram (Sub_Id)) then if Lock_Free_Given then Error_Msg_NE @@ -647,7 +648,6 @@ package body Sem_Ch9 is and then (not Lock_Free_Given or else Errors_Count = Serious_Errors_Detected) then - -- Establish a relation between the subprogram body and the -- unique protected component it references. diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb index 3d0e1dd348d..0f518375a1e 100644 --- a/gcc/ada/sem_dim.adb +++ b/gcc/ada/sem_dim.adb @@ -1712,9 +1712,7 @@ package body Sem_Dim is -- entity when the object is a constant whose type is a -- dimensioned type. - if Constant_Present (N) - and then not Exists (Dim_Of_Etyp) - then + if Constant_Present (N) and then not Exists (Dim_Of_Etyp) then Set_Dimensions (Id, Dim_Of_Expr); -- Otherwise, issue an error message diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 65c64f2ec6b..257e4d5566b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7129,9 +7129,9 @@ package body Sem_Res is return; end if; - else - -- If not overloaded, resolve P with its own type + -- If not overloaded, resolve P with its own type + else Resolve (P); end if; |