diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 25 | ||||
| -rw-r--r-- | gcc/ada/a-crbtgk.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 25 |
5 files changed, 113 insertions, 18 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3172ef7..dcf04f9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2011-12-21 Matthew Heaney <heaney@adacore.com> + + * a-crbtgk.adb (Generic_Conditional_Insert): Fixed incorrect comment. + +2011-12-21 Ed Schonberg <schonberg@adacore.com> + + * sem_ch5.adb (Analyze_Iterator_Specification): If the name + of an element iterator is not an entity name we introduce a + local renaming declaration for it. To prevent spurious warnings + on parameterless function calls that return a container, when + expansion is disabled (either explicitly or because of a previous + errors) the name must be marked as not coming from source. + +2011-12-21 Arnaud Charlet <charlet@adacore.com> + + * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Separate + handling in CodePeer mode and only ignore Component_Size + attribute. + +2011-12-21 Robert Dewar <dewar@adacore.com> + + * sem_ch6.adb (Process_Formals): Set proper mechanism for + formals whose types have conventions Ada_Pass_By_Copy or + Ada_Pass_By_Reference. + 2011-12-21 Arnaud Charlet <charlet@adacore.com> * gnat1drv.adb (Gnat1Drv): Always delete old scil files in diff --git a/gcc/ada/a-crbtgk.adb b/gcc/ada/a-crbtgk.adb index 59d25be..713e542 100644 --- a/gcc/ada/a-crbtgk.adb +++ b/gcc/ada/a-crbtgk.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -121,6 +121,21 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is X : Node_Access := Tree.Root; begin + -- This is a "conditional" insertion, meaning that the insertion request + -- can "fail" in the sense that no new node is created. If the Key is + -- equivalent to an existing node, then we return the existing node and + -- Inserted is set to False. Otherwise, we allocate a new node (via + -- Insert_Post) and Inserted is set to True. + + -- Note that we are testing for equivalence here, not equality. Key must + -- be strictly less than its next neighbor, and strictly greater than + -- its previous neighbor, in order for the conditional insertion to + -- succeed. + + -- We search the tree to find the nearest neighbor of Key, which is + -- either the smallest node greater than Key (Inserted is True), or the + -- largest node less or equivalent to Key (Inserted is False). + Inserted := True; while X /= null loop Y := X; @@ -128,33 +143,50 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is X := (if Inserted then Ops.Left (X) else Ops.Right (X)); end loop; - -- If Inserted is True, then this means either that Tree is - -- empty, or there was a least one node (strictly) greater than - -- Key. Otherwise, it means that Key is equal to or greater than - -- every node. - if Inserted then + + -- Either Tree is empty, or Key is less than Y. If Y is the first + -- node in the tree, then there are no other nodes that we need to + -- search for, and we insert a new node into the tree. + if Y = Tree.First then Insert_Post (Tree, Y, True, Node); return; end if; + -- Y is the next nearest-neighbor of Key. We know that Key is not + -- equivalent to Y (because Key is strictly less than Y), so we move + -- to the previous node, the nearest-neighbor just smaller or + -- equivalent to Key. + Node := Ops.Previous (Y); else + -- Y is the previous nearest-neighbor of Key. We know that Key is not + -- less than Y, which means either that Key is equivalent to Y, or + -- greater than Y. + Node := Y; end if; - -- Here Node has a value that is less than or equal to Key. We - -- now have to resolve whether Key is equal to or greater than - -- Node, which determines whether the insertion succeeds. + -- Key is equivalent to or greater than Node. We must resolve which is + -- the case, to determine whether the conditional insertion succeeds. if Is_Greater_Key_Node (Key, Node) then + + -- Key is strictly greater than Node, which means that Key is not + -- equivalent to Node. In this case, the insertion succeeds, and we + -- insert a new node into the tree. + Insert_Post (Tree, Y, Inserted, Node); Inserted := True; return; end if; + -- Key is equivalent to Node. This is a conditional insertion, so we do + -- not insert a new node in this case. We return the existing node and + -- report that no insertion has occurred. + Inserted := False; end Generic_Conditional_Insert; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index a4848fe..98fd99e 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -2108,11 +2108,28 @@ package body Sem_Ch13 is Set_Analyzed (N, True); end if; + -- Ignore some selected attributes in CodePeer mode since they are not + -- relevant in this context. + + if CodePeer_Mode then + case Id is + + -- Ignore Component_Size in CodePeer mode, to avoid changing the + -- internal representation of types by implicitly packing them. + + when Attribute_Component_Size => + Rewrite (N, Make_Null_Statement (Sloc (N))); + return; + + when others => + null; + end case; + end if; + -- Process Ignore_Rep_Clauses option (we also ignore rep clauses in - -- CodePeer mode or Alfa mode, since they are not relevant in these - -- contexts). + -- Alfa mode, since they are not relevant in this context). - if Ignore_Rep_Clauses or CodePeer_Mode or Alfa_Mode then + if Ignore_Rep_Clauses or Alfa_Mode then case Id is -- The following should be ignored. They do not affect legality diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 54819b8..f3188b0 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2257,11 +2257,17 @@ package body Sem_Ch5 is begin Typ := Etype (Iter_Name); + -- The name in the renaming declaration may be a function call. + -- Indicate that it does not come from source, to suppress + -- spurious warnings on renamings of parameterless functions, + -- a common enough idiom in user-defined iterators. + Decl := Make_Object_Renaming_Declaration (Loc, Defining_Identifier => Id, Subtype_Mark => New_Occurrence_Of (Typ, Loc), - Name => Relocate_Node (Iter_Name)); + Name => + New_Copy_Tree (Iter_Name, New_Sloc => Loc)); Insert_Actions (Parent (Parent (N)), New_List (Decl)); Rewrite (Name (N), New_Occurrence_Of (Id, Loc)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index dbb4bb8..1df3737 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -9527,14 +9527,14 @@ package body Sem_Ch6 is Default := Expression (Param_Spec); if Is_Scalar_Type (Etype (Default)) then - if Nkind - (Parameter_Type (Param_Spec)) /= N_Access_Definition + if Nkind (Parameter_Type (Param_Spec)) /= + N_Access_Definition then Formal_Type := Entity (Parameter_Type (Param_Spec)); - else - Formal_Type := Access_Definition - (Related_Nod, Parameter_Type (Param_Spec)); + Formal_Type := + Access_Definition + (Related_Nod, Parameter_Type (Param_Spec)); end if; Apply_Scalar_Range_Check (Default, Formal_Type); @@ -9556,6 +9556,21 @@ package body Sem_Ch6 is if Is_Aliased (Formal) then Set_Mechanism (Formal, By_Reference); + + -- Warn if user asked this to be passed by copy + + if Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then + Error_Msg_N + ("?cannot pass aliased parameter & by copy", Formal); + end if; + + -- Force mechanism if type has Convention Ada_Pass_By_Ref/Copy + + elsif Convention (Formal_Type) = Convention_Ada_Pass_By_Copy then + Set_Mechanism (Formal, By_Copy); + + elsif Convention (Formal_Type) = Convention_Ada_Pass_By_Reference then + Set_Mechanism (Formal, By_Reference); end if; Next (Param_Spec); |