diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-01-27 16:54:37 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2014-01-27 16:54:37 +0000 |
commit | 8f3b5017c4f49ebbacda56a6eeb17f9735582a0e (patch) | |
tree | d7021741bf39c55d0e737810af9bddd5a46496fe /gcc/ada | |
parent | 3c9851e9c8e2913859171354644e3ca4062e34c8 (diff) | |
download | gcc-8f3b5017c4f49ebbacda56a6eeb17f9735582a0e.tar.gz |
2014-01-27 Tristan Gingold <gingold@adacore.com>
* exp_ch7.adb, exp_ch9.adb: Adjust comments.
2014-01-27 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb (Expand_N_Op_Expon): Remove unsigned type test
for 2**X optimization.
2014-01-27 Ed Schonberg <schonberg@adacore.com>
* a-suenst.adb: strings.utf_encoding.strings (Decode): Check
explicitly whether value is in range of Character, because the
library is typically compiled with range checks disabled, and
we cannot rely on the implicit check on the argument of 'Val.
2014-01-27 Vincent Celier <celier@adacore.com>
* a-ciorma.adb, a-cihama.adb (Assign): Copy the Source to the Target,
not the Target to itself.
2014-01-27 Robert Dewar <dewar@adacore.com>
* vms_conv.ads, ali.adb, sem_ch6.ads, opt.ads, vms_cmds.ads: Minor
changes to avoid incorrect use of unordered enum types.
2014-01-27 Thomas Quinot <quinot@adacore.com>
* sem_ch4.adb: Minor reformatting.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@207144 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/ChangeLog | 30 | ||||
-rw-r--r-- | gcc/ada/a-cihama.adb | 2 | ||||
-rw-r--r-- | gcc/ada/a-ciorma.adb | 2 | ||||
-rw-r--r-- | gcc/ada/a-suenst.adb | 15 | ||||
-rw-r--r-- | gcc/ada/ali.adb | 2 | ||||
-rw-r--r-- | gcc/ada/exp_ch4.adb | 6 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.adb | 7 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 8 | ||||
-rw-r--r-- | gcc/ada/opt.ads | 4 | ||||
-rw-r--r-- | gcc/ada/sem_ch4.adb | 184 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.ads | 3 | ||||
-rw-r--r-- | gcc/ada/vms_cmds.ads | 5 | ||||
-rw-r--r-- | gcc/ada/vms_conv.ads | 4 |
13 files changed, 155 insertions, 117 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 048cf2ae9f2..0873ba4e7eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +2014-01-27 Tristan Gingold <gingold@adacore.com> + + * exp_ch7.adb, exp_ch9.adb: Adjust comments. + +2014-01-27 Robert Dewar <dewar@adacore.com> + + * exp_ch4.adb (Expand_N_Op_Expon): Remove unsigned type test + for 2**X optimization. + +2014-01-27 Ed Schonberg <schonberg@adacore.com> + + * a-suenst.adb: strings.utf_encoding.strings (Decode): Check + explicitly whether value is in range of Character, because the + library is typically compiled with range checks disabled, and + we cannot rely on the implicit check on the argument of 'Val. + +2014-01-27 Vincent Celier <celier@adacore.com> + + * a-ciorma.adb, a-cihama.adb (Assign): Copy the Source to the Target, + not the Target to itself. + +2014-01-27 Robert Dewar <dewar@adacore.com> + + * vms_conv.ads, ali.adb, sem_ch6.ads, opt.ads, vms_cmds.ads: Minor + changes to avoid incorrect use of unordered enum types. + +2014-01-27 Thomas Quinot <quinot@adacore.com> + + * sem_ch4.adb: Minor reformatting. + 2014-01-27 Robert Dewar <dewar@adacore.com> * scn.adb (Check_End_Of_Line): Removed. diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index e3e3d5ee43d..4e4d240e394 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -169,7 +169,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is Target.Reserve_Capacity (Source.Length); end if; - Insert_Items (Target.HT); + Insert_Items (Source.HT); end Assign; -------------- diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index b836dc69fd0..1c6f6d737fc 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -313,7 +313,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is end if; Target.Clear; - Insert_Items (Target.Tree); + Insert_Items (Source.Tree); end Assign; ------------- diff --git a/gcc/ada/a-suenst.adb b/gcc/ada/a-suenst.adb index 87e5893f16b..2ed5c2c0c6c 100644 --- a/gcc/ada/a-suenst.adb +++ b/gcc/ada/a-suenst.adb @@ -154,16 +154,19 @@ package body Ada.Strings.UTF_Encoding.Strings is end if; Len := Len + 1; + + -- The value may still be out of range of Standard.Character. We make + -- the check explicit because the library is typically compiled with + -- range checks disabled. + + if R > Character'Pos (Character'Last) then + Raise_Encoding_Error (Iptr - 1); + end if; + Result (Len) := Character'Val (R); end loop; return Result (1 .. Len); - - exception - -- 'Val may have been out of range - - when others => - Raise_Encoding_Error (Iptr - 1); end Decode; -- Decode UTF-16 input to String diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb index aff6740f405..87cb61d4f54 100644 --- a/gcc/ada/ali.adb +++ b/gcc/ada/ali.adb @@ -1290,7 +1290,7 @@ package body ALI is begin R := Restriction_Id'First; - while R < Not_A_Restriction_Id loop + while R /= Not_A_Restriction_Id loop if Restriction_Id'Image (R) = RN then goto R_Found; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index d0288b2dd20..6952665ce21 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7469,12 +7469,16 @@ package body Exp_Ch4 is -- a non-binary modulus in the multiplication case, since we get a wrong -- result if the shift causes an overflow before the modular reduction. + -- Note: we used to check that Exptyp was an unsigned type. But that is + -- an unnecessary check, since if Exp is negative, we have a run-time + -- error that is either caught (so we get the right result) or we have + -- suppressed the check, in which case the code is erroneous anyway. + if Nkind (Base) = N_Integer_Literal and then CRT_Safe_Compile_Time_Known_Value (Base) and then Expr_Value (Base) = Uint_2 and then Is_Integer_Type (Root_Type (Exptyp)) and then Esize (Root_Type (Exptyp)) <= Esize (Standard_Integer) - and then Is_Unsigned_Type (Exptyp) and then not Ovflo then -- First the multiply and divide cases diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1e0c9bbd3fe..ddf6d7ea819 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -532,11 +532,8 @@ package body Exp_Ch7 is pragma Assert (Present (Param)); -- Historical note: In earlier versions of GNAT, there was code - -- at this point to generate stuff to service entry queues. But - -- that was wrong thinking. This was useless and resulted in - -- incoherencies between code generated with and without -gnatp. - - -- All that is needed at this stage is a normal cleanup call + -- at this point to generate stuff to service entry queues. It is + -- now abstracted in Build_Protected_Subprogram_Call_Cleanup. Build_Protected_Subprogram_Call_Cleanup (Specification (N), Conc_Typ, Loc, Stmts); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 96a09279ce4..b85dd015f45 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -4278,6 +4278,10 @@ package body Exp_Ch9 is Append (Unprot_Call, Stmts); end if; + -- Historical note: Previously, call the the cleanup was inserted + -- here. This is now done by Build_Protected_Subprogram_Call_Cleanup, + -- which is also shared by the 'not Exc_Safe' path. + Build_Protected_Subprogram_Call_Cleanup (Op_Spec, Pid, Loc, Stmts); if Nkind (Op_Spec) = N_Function_Specification then @@ -4298,6 +4302,10 @@ package body Exp_Ch9 is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Stmts)); + -- Mark this subprogram as a protected subprogram body so that the + -- cleanup will be inserted. This is done only in the 'not Exc_Safe' + -- path as otherwise the cleanup has already been inserted. + if not Exc_Safe then Set_Is_Protected_Subprogram_Body (Sub_Body); end if; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 344caaf6397..f5349f55b2d 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1064,6 +1064,7 @@ package Opt is -- object directory, if project files are used. type Operating_Mode_Type is (Check_Syntax, Check_Semantics, Generate_Code); + pragma Ordered (Operating_Mode_Type); Operating_Mode : Operating_Mode_Type := Generate_Code; -- GNAT -- Indicates the operating mode of the compiler. The default is generate @@ -1072,7 +1073,8 @@ package Opt is -- only mode. Operating_Mode can also be modified as a result of detecting -- errors during the compilation process. In particular if any serious -- error is detected then this flag is reset from Generate_Code to - -- Check_Semantics after generating an error message. + -- Check_Semantics after generating an error message. This is an ordered + -- type with the semantics that each value does more than the previous one. Optimize_Alignment : Character := 'O'; -- Setting of Optimize_Alignment, set to T/S/O for time/space/off. Can diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 29e3e2faaac..1512a7ad240 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4594,15 +4594,15 @@ package body Sem_Ch4 is Check_Misspelled_Selector (Type_To_Use, Sel); + -- If this is a derived formal type, the parent may have different + -- visibility at this point. Try for an inherited component before + -- reporting an error. + elsif Is_Generic_Type (Prefix_Type) and then Ekind (Prefix_Type) = E_Record_Type_With_Private and then Prefix_Type /= Etype (Prefix_Type) and then Is_Record_Type (Etype (Prefix_Type)) then - -- If this is a derived formal type, the parent may have - -- different visibility at this point. Try for an inherited - -- component before reporting an error. - Set_Etype (Prefix (N), Etype (Prefix_Type)); Analyze_Selected_Component (N); return; @@ -4615,7 +4615,6 @@ package body Sem_Ch4 is and then Is_Generic_Actual_Type (Prefix_Type) and then Present (Full_View (Prefix_Type)) then - Find_Component_In_Instance (Generic_Parent_Type (Parent (Prefix_Type))); return; @@ -5034,13 +5033,13 @@ package body Sem_Ch4 is then Add_One_Interp (N, Op_Id, Etype (Op_Id)); - -- If the left operand is overloaded, indicate that the - -- current type is a viable candidate. This is redundant - -- in most cases, but for equality and comparison operators - -- where the context does not impose a type on the operands, - -- setting the proper type is necessary to avoid subsequent - -- ambiguities during resolution, when both user-defined and - -- predefined operators may be candidates. + -- If the left operand is overloaded, indicate that the current + -- type is a viable candidate. This is redundant in most cases, + -- but for equality and comparison operators where the context + -- does not impose a type on the operands, setting the proper + -- type is necessary to avoid subsequent ambiguities during + -- resolution, when both user-defined and predefined operators + -- may be candidates. if Is_Overloaded (Left_Opnd (N)) then Set_Etype (Left_Opnd (N), Etype (F1)); @@ -5108,7 +5107,7 @@ package body Sem_Ch4 is -- (multiplication or division) that should hide the corresponding -- predefined operator. Used to implement Ada 2005 AI-264, to make -- such operators more visible and therefore useful. - + -- -- If the name of the operation is an expanded name with prefix -- Standard, the predefined universal fixed operator is available, -- as specified by AI-420 (RM 4.5.5 (19.1/2)). @@ -5325,11 +5324,11 @@ package body Sem_Ch4 is Comp : Entity_Id; begin - -- All the components of the prefix of selector Sel are matched - -- against Sel and a count is maintained of possible misspellings. - -- When at the end of the analysis there are one or two (not more!) - -- possible misspellings, these misspellings will be suggested as - -- possible correction. + -- All the components of the prefix of selector Sel are matched against + -- Sel and a count is maintained of possible misspellings. When at + -- the end of the analysis there are one or two (not more!) possible + -- misspellings, these misspellings will be suggested as possible + -- correction. if not (Is_Private_Type (Prefix) or else Is_Record_Type (Prefix)) then @@ -5661,21 +5660,17 @@ package body Sem_Ch4 is -- universal, the context will impose the correct type. if Present (Scop) - and then not Defined_In_Scope (T1, Scop) - and then T1 /= Universal_Integer - and then T1 /= Universal_Real - and then T1 /= Any_String - and then T1 /= Any_Composite + and then not Defined_In_Scope (T1, Scop) + and then T1 /= Universal_Integer + and then T1 /= Universal_Real + and then T1 /= Any_String + and then T1 /= Any_Composite then return; end if; - if Valid_Comparison_Arg (T1) - and then Has_Compatible_Type (R, T1) - then - if Found - and then Base_Type (T1) /= Base_Type (T_F) - then + if Valid_Comparison_Arg (T1) and then Has_Compatible_Type (R, T1) then + if Found and then Base_Type (T1) /= Base_Type (T_F) then It := Disambiguate (L, I_F, Index, Any_Type); if It = No_Interp then @@ -5705,9 +5700,7 @@ package body Sem_Ch4 is -- If left operand is aggregate, the right operand has to -- provide a usable type for it. - if Nkind (L) = N_Aggregate - and then Nkind (R) /= N_Aggregate - then + if Nkind (L) = N_Aggregate and then Nkind (R) /= N_Aggregate then Find_Comparison_Types (L => R, R => L, Op_Id => Op_Id, N => N); return; end if; @@ -5754,8 +5747,7 @@ package body Sem_Ch4 is It : Interp; begin - if T1 = Universal_Integer - or else T1 = Universal_Real + if T1 = Universal_Integer or else T1 = Universal_Real -- If the left operand of an equality operator is null, the visibility -- of the operator must be determined from the interpretation of the @@ -5765,8 +5757,7 @@ package body Sem_Ch4 is or else T1 = Any_Access then if not Is_Overloaded (R) then - Add_One_Interp - (N, Op_Id, Standard_Boolean, Base_Type (Etype (R))); + Add_One_Interp (N, Op_Id, Standard_Boolean, Base_Type (Etype (R))); else Get_First_Interp (R, Index, It); while Present (It.Typ) loop @@ -5846,6 +5837,7 @@ package body Sem_Ch4 is -- universal, the context will impose the correct type. An anonymous -- type for a 'Access reference is also universal in this sense, as -- the actual type is obtained from context. + -- In Ada 2005, the equality operator for anonymous access types -- is declared in Standard, and preference rules apply to it. @@ -5916,9 +5908,9 @@ package body Sem_Ch4 is -- If the right operand has a type compatible with T1, check for an -- acceptable interpretation, unless T1 is limited (no predefined -- equality available), or this is use of a "/=" for a tagged type. - -- In the latter case, possible interpretations of equality need to - -- be considered, we don't want the default inequality declared in - -- Standard to be chosen, and the "/=" will be rewritten as a + -- In the latter case, possible interpretations of equality need + -- to be considered, we don't want the default inequality declared + -- in Standard to be chosen, and the "/=" will be rewritten as a -- negation of "=" (see the end of Analyze_Equality_Op). This ensures -- that that rewriting happens during analysis rather than being -- delayed until expansion (this is needed for ASIS, which only sees @@ -6113,12 +6105,12 @@ package body Sem_Ch4 is (Base_Type (Etype (First_Formal (Hom))) = Cls_Type or else (Is_Access_Type (Etype (First_Formal (Hom))) - and then - Ekind (Etype (First_Formal (Hom))) = - E_Anonymous_Access_Type - and then - Base_Type - (Designated_Type (Etype (First_Formal (Hom)))) = + and then + Ekind (Etype (First_Formal (Hom))) = + E_Anonymous_Access_Type + and then + Base_Type + (Designated_Type (Etype (First_Formal (Hom)))) = Cls_Type)) then Add_One_Interp (Op, Hom, Etype (Hom)); @@ -6353,7 +6345,7 @@ package body Sem_Ch4 is else Error_Msg_NE -- CODEFIX ("add with_clause and use_clause for&!", - N, Defining_Entity (Unit (U))); + N, Defining_Entity (Unit (U))); end if; end; return; @@ -6576,7 +6568,7 @@ package body Sem_Ch4 is ("No legal interpretation for operator&", N); Error_Msg_NE ("\use clause on& would make operation legal", - N, Scope (Op_Id)); + N, Scope (Op_Id)); exit; end if; end if; @@ -6625,19 +6617,18 @@ package body Sem_Ch4 is if Present (E) and then (Operating_Mode = Check_Semantics or else not Expander_Active) then - -- We create a dummy reference to E to ensure that the reference - -- is not considered as part of an assignment (an implicit - -- dereference can never assign to its prefix). The Comes_From_Source - -- attribute needs to be propagated for accurate warnings. + -- We create a dummy reference to E to ensure that the reference is + -- not considered as part of an assignment (an implicit dereference + -- can never assign to its prefix). The Comes_From_Source attribute + -- needs to be propagated for accurate warnings. Ref := New_Reference_To (E, Sloc (P)); Set_Comes_From_Source (Ref, Comes_From_Source (P)); Generate_Reference (E, Ref); end if; - -- An implicit dereference is a legal occurrence of an - -- incomplete type imported through a limited_with clause, - -- if the full view is visible. + -- An implicit dereference is a legal occurrence of an incomplete type + -- imported through a limited_with clause, if the full view is visible. if From_Limited_With (Typ) and then not From_Limited_With (Scope (Typ)) @@ -6676,8 +6667,8 @@ package body Sem_Ch4 is procedure Remove_Address_Interpretations (Op : Operand_Position); -- Ambiguities may arise when the operands are literal and the address -- operations in s-auxdec are visible. In that case, remove the - -- interpretation of a literal as Address, to retain the semantics of - -- Address as a private type. + -- interpretation of a literal as Address, to retain the semantics + -- of Address as a private type. ------------------------------------ -- Remove_Address_Interpretations -- @@ -6779,9 +6770,9 @@ package body Sem_Ch4 is if Nkind (N) in N_Binary_Op then declare U1 : constant Boolean := - Present (Universal_Interpretation (Right_Opnd (N))); + Present (Universal_Interpretation (Right_Opnd (N))); U2 : constant Boolean := - Present (Universal_Interpretation (Left_Opnd (N))); + Present (Universal_Interpretation (Left_Opnd (N))); begin if U1 then @@ -7008,15 +6999,16 @@ package body Sem_Ch4 is end if; else - Indexing := Make_Function_Call (Loc, - Name => Make_Identifier (Loc, Chars (Func_Name)), - Parameter_Associations => Assoc); + Indexing := + Make_Function_Call (Loc, + Name => Make_Identifier (Loc, Chars (Func_Name)), + Parameter_Associations => Assoc); Rewrite (N, Indexing); declare - I : Interp_Index; - It : Interp; + I : Interp_Index; + It : Interp; Success : Boolean; begin @@ -7103,6 +7095,7 @@ package body Sem_Ch4 is end if; return True; + else return False; end if; @@ -7212,8 +7205,8 @@ package body Sem_Ch4 is -- Identifier on which possible interpretations will be collected Report_Error : Boolean := False; - -- If no candidate interpretation matches the context, redo the - -- analysis with error enabled to provide additional information. + -- If no candidate interpretation matches the context, redo analysis + -- with Report_Error True to provide additional information. Actual : Node_Id; Candidate : Entity_Id := Empty; @@ -7372,9 +7365,9 @@ package body Sem_Ch4 is First_Actual := First (Parameter_Associations (Call_Node)); - -- For cross-reference purposes, treat the new node as being in - -- the source if the original one is. Set entity and type, even - -- though they may be overwritten during resolution if overloaded. + -- For cross-reference purposes, treat the new node as being in the + -- source if the original one is. Set entity and type, even though + -- they may be overwritten during resolution if overloaded. Set_Comes_From_Source (Subprog, Comes_From_Source (N)); Set_Comes_From_Source (Call_Node, Comes_From_Source (N)); @@ -7386,9 +7379,9 @@ package body Sem_Ch4 is Set_Etype (Selector_Name (N), Etype (Entity (Subprog))); end if; - -- If need be, rewrite first actual as an explicit dereference - -- If the call is overloaded, the rewriting can only be done - -- once the primitive operation is identified. + -- If need be, rewrite first actual as an explicit dereference. If + -- the call is overloaded, the rewriting can only be done once the + -- primitive operation is identified. if Is_Overloaded (Subprog) then @@ -7503,8 +7496,8 @@ package body Sem_Ch4 is if Access_Formal and then not Access_Actual then if Nkind (Parent (Op)) = N_Full_Type_Declaration then Error_Msg_N - ("\possible interpretation" - & " (inherited, with implicit 'Access) #", N); + ("\possible interpretation " + & "(inherited, with implicit 'Access) #", N); else Error_Msg_N ("\possible interpretation (with implicit 'Access) #", N); @@ -7513,8 +7506,8 @@ package body Sem_Ch4 is elsif not Access_Formal and then Access_Actual then if Nkind (Parent (Op)) = N_Full_Type_Declaration then Error_Msg_N - ("\possible interpretation" - & " ( inherited, with implicit dereference) #", N); + ("\possible interpretation " + & "( inherited, with implicit dereference) #", N); else Error_Msg_N ("\possible interpretation (with implicit dereference) #", N); @@ -7582,9 +7575,8 @@ package body Sem_Ch4 is else Call_Node := Make_Function_Call (Loc, - Name => New_Copy (Subprog), + Name => New_Copy (Subprog), Parameter_Associations => Actuals); - end if; -- Before analysis, a function call appears as an indexed component @@ -7606,7 +7598,7 @@ package body Sem_Ch4 is Call_Node := Make_Function_Call (Loc, - Name => New_Copy (Subprog), + Name => New_Copy (Subprog), Parameter_Associations => Actuals); -- Parameterless call: Obj.F is rewritten as F (Obj) @@ -7616,7 +7608,7 @@ package body Sem_Ch4 is Call_Node := Make_Function_Call (Loc, - Name => New_Copy (Subprog), + Name => New_Copy (Subprog), Parameter_Associations => New_List (Dummy)); end if; end Transform_Object_Operation; @@ -7671,8 +7663,8 @@ package body Sem_Ch4 is -- Find a non-hidden operation whose first parameter is of the -- class-wide type, a subtype thereof, or an anonymous access -- to same. If in an instance, the operation can be considered - -- even if hidden (it may be hidden because the instantiation is - -- expanded after the containing package has been analyzed). + -- even if hidden (it may be hidden because the instantiation + -- is expanded after the containing package has been analyzed). while Present (Hom) loop if Ekind_In (Hom, E_Procedure, E_Function) @@ -7683,12 +7675,12 @@ package body Sem_Ch4 is (Base_Type (Etype (First_Formal (Hom))) = Cls_Type or else (Is_Access_Type (Etype (First_Formal (Hom))) - and then - Ekind (Etype (First_Formal (Hom))) = - E_Anonymous_Access_Type - and then - Base_Type - (Designated_Type (Etype (First_Formal (Hom)))) = + and then + Ekind (Etype (First_Formal (Hom))) = + E_Anonymous_Access_Type + and then + Base_Type + (Designated_Type (Etype (First_Formal (Hom)))) = Cls_Type)) then -- If the context is a procedure call, ignore functions @@ -7931,12 +7923,12 @@ package body Sem_Ch4 is Matching_Op : Entity_Id := Empty; Prim_Op_Ref : Node_Id := Empty; - Corr_Type : Entity_Id := Empty; + Corr_Type : Entity_Id := Empty; -- If the prefix is a synchronized type, the controlling type of -- the primitive operation is the corresponding record type, else -- this is the object type itself. - Success : Boolean := False; + Success : Boolean := False; function Collect_Generic_Type_Ops (T : Entity_Id) return Elist_Id; -- For tagged types the candidate interpretations are found in @@ -7946,6 +7938,7 @@ package body Sem_Ch4 is -- part) because the type itself carries no primitive operations, -- except for formal derived types that inherit the operations of -- the parent and progenitors. + -- -- If the context is a generic subprogram body, the generic formals -- are visible by name, but are not in the entity list of the -- subprogram because that list starts with the subprogram formals. @@ -8007,8 +8000,8 @@ package body Sem_Ch4 is -- Scan the list of generic formals to find subprograms -- that may have a first controlling formal of the type. - if Nkind (Unit_Declaration_Node (Scope (T))) - = N_Generic_Subprogram_Declaration + if Nkind (Unit_Declaration_Node (Scope (T))) = + N_Generic_Subprogram_Declaration then declare Decl : Node_Id; @@ -8143,10 +8136,11 @@ package body Sem_Ch4 is and then Valid_First_Argument_Of (Prim_Op) and then (Nkind (Call_Node) = N_Function_Call) - = (Ekind (Prim_Op) = E_Function) + = + (Ekind (Prim_Op) = E_Function) then -- Ada 2005 (AI-251): If this primitive operation corresponds - -- with an immediate ancestor interface there is no need to add + -- to an immediate ancestor interface there is no need to add -- it to the list of interpretations; the corresponding aliased -- primitive is also in this list of primitive operations and -- will be used instead. @@ -8289,8 +8283,8 @@ package body Sem_Ch4 is if All_Errors_Mode then Report_Error := True; if Try_Primitive_Operation - (Call_Node => New_Call_Node, - Node_To_Replace => Node_To_Replace) + (Call_Node => New_Call_Node, + Node_To_Replace => Node_To_Replace) or else Try_Class_Wide_Operation diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index fc0c365e06b..e03341c199b 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -28,8 +28,7 @@ package Sem_Ch6 is type Conformance_Type is (Type_Conformant, Mode_Conformant, Subtype_Conformant, Fully_Conformant); - -- pragma Ordered (Conformance_Type); - -- Why is above line commented out ??? + pragma Ordered (Conformance_Type); -- Conformance type used in conformance checks between specs and bodies, -- and for overriding. The literals match the RM definitions of the -- corresponding terms. This is an ordered type, since each conformance diff --git a/gcc/ada/vms_cmds.ads b/gcc/ada/vms_cmds.ads index d61e3eddf31..f8258af8e3d 100644 --- a/gcc/ada/vms_cmds.ads +++ b/gcc/ada/vms_cmds.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2010-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2013, 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- -- @@ -50,4 +50,7 @@ package VMS_Cmds is Test, Xref, Undefined); + + subtype Real_Command_Type is Command_Type range Bind .. Xref; + -- All real command types (excludes only Undefined). end VMS_Cmds; diff --git a/gcc/ada/vms_conv.ads b/gcc/ada/vms_conv.ads index 7e2127f10a2..bba701505df 100644 --- a/gcc/ada/vms_conv.ads +++ b/gcc/ada/vms_conv.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2003-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2003-2013, 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- -- @@ -104,8 +104,6 @@ package VMS_Conv is Pp => Pretty); -- Mapping of alternate commands to commands - subtype Real_Command_Type is Command_Type range Bind .. Xref; - type Command_Entry is record Cname : String_Ptr; -- Command name for GNAT xxx command |