diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 34 | ||||
| -rw-r--r-- | gcc/ada/aspects.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_dbug.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/exp_dbug.ads | 18 | ||||
| -rw-r--r-- | gcc/ada/i-cstrea.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/prj-makr.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/prj.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/s-crtl.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/s-stratt-xdr.adb | 131 | ||||
| -rw-r--r-- | gcc/ada/sem_aux.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 113 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/sinfo-cn.adb | 23 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/warnsw.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/warnsw.ads | 6 |
16 files changed, 282 insertions, 143 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9a5a99d79c9..7ec41ce0bae 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2012-10-29 Ed Schonberg <schonberg@adacore.com> + + * sem_aux.adb (Get_Rep_Item): Treat Priority and Interrupt_Priority + as equivalent, because only one of them can be specified for a + task, protected definition, or subprogram body. + * aspects.adb ((Same_Aspect): The canonical aspect of + Interrupt_Priority is Priority. + +2012-10-29 Robert Dewar <dewar@adacore.com> + + * sem_ch13.adb: Minor reformatting. + +2012-10-29 Robert Dewar <dewar@adacore.com> + + * i-cstrea.ads: Avoid redefinition of standard symbol string. + * prj-makr.adb: Add comment for OK redefinition of Stadard. + * prj.ads: Add comment for OK redefinition of Stadard. + * s-crtl.ads: Avoid redefinition of standard symbol string. + * sinfo-cn.adb (Change_Identifier_To_Defining_Identifier): + Generate warning for standard redefinition if + Warn_On_Standard_Definition set. + * usage.adb: Add lines for -gnatw.k and -gnatw.K + * warnsw.adb: Set/reset Warn_On_Standard_Redefinition + appropriately. + * warnsw.ads (Warn_On_Standard_Redefinition): New flag. + * s-stratt-xdr.adb: Avoid new warning. + +2012-10-29 Ed Schonberg <schonberg@adacore.com> + + * exp_dbug.ads, exp_dbug.adb (Build_Subprogram_Instance_Renamings): + in the body of a subpogram instance, introduce local renamings + for actuals of an elementary type, so that GDB can recover the + values of these actuals more directly. + 2012-10-29 Robert Dewar <dewar@adacore.com> * sem_ch5.adb (Analyze_Loop_Statement): Add warning for identical diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 6605b7185ca..880ee244578 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -275,7 +275,7 @@ package body Aspects is Aspect_Inline_Always => Aspect_Inline, Aspect_Input => Aspect_Input, Aspect_Interrupt_Handler => Aspect_Interrupt_Handler, - Aspect_Interrupt_Priority => Aspect_Interrupt_Priority, + Aspect_Interrupt_Priority => Aspect_Priority, Aspect_Invariant => Aspect_Invariant, Aspect_Iterator_Element => Aspect_Iterator_Element, Aspect_Link_Name => Aspect_Link_Name, diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 5d605d75c50..582138f3c4a 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2012, 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- -- @@ -902,6 +902,39 @@ package body Exp_Dbug is end if; end Get_Variant_Encoding; + ------------------------------------------ + -- Build_Subprogram_Instance_Renamings -- + ------------------------------------------ + + procedure Build_Subprogram_Instance_Renamings + (N : Node_Id; + Wrapper : Entity_Id) + is + Loc : Source_Ptr; + Decl : Node_Id; + E : Entity_Id; + + begin + E := First_Entity (Wrapper); + while Present (E) loop + if Nkind (Parent (E)) = N_Object_Declaration + and then Is_Elementary_Type (Etype (E)) + then + Loc := Sloc (Expression (Parent (E))); + Decl := Make_Object_Renaming_Declaration (Loc, + Defining_Identifier => + Make_Defining_Identifier (Loc, Chars (E)), + Subtype_Mark => New_Occurrence_Of (Etype (E), Loc), + Name => New_Occurrence_Of (E, Loc)); + + Append (Decl, Declarations (N)); + Set_Needs_Debug_Info (Defining_Identifier (Decl)); + end if; + + Next_Entity (E); + end loop; + end Build_Subprogram_Instance_Renamings; + ------------------------------------ -- Get_Secondary_DT_External_Name -- ------------------------------------ diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index 0290168ff01..41d4090639f 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -1442,6 +1442,24 @@ package Exp_Dbug is -- corresponding to variants, and consider the fields inside as belonging -- to the containing record. + ----------------------------------------------- + -- Extra renamings for subprogram instances -- + ----------------------------------------------- + + procedure Build_Subprogram_Instance_Renamings + (N : Node_Id; + Wrapper : Entity_Id); + + -- The debugger has difficulties in recovering the value of actuals of an + -- elementary type, from within the body of a subprogram instantiation. + -- This is because such actuals generate an object declaration that is + -- placed within the wrapper package of the instance, and the entity in + -- these declarations is encoded in a complex way that GDB does not handle + -- well. These new renaming declarations appear within the body of the + -- subprogram, and are redundant from a visibility point of view, but They + -- should have no measurable performance impact, and require no special + -- decoding in the debugger. + ------------------------------------------- -- Character literals in Character Types -- ------------------------------------------- diff --git a/gcc/ada/i-cstrea.ads b/gcc/ada/i-cstrea.ads index 37d8ab733db..8882a7d3de6 100644 --- a/gcc/ada/i-cstrea.ads +++ b/gcc/ada/i-cstrea.ads @@ -175,7 +175,7 @@ package Interfaces.C_Streams is mode : int; size : size_t) return int; - procedure tmpnam (string : chars) renames System.CRTL.tmpnam; + procedure tmpnam (str : chars) renames System.CRTL.tmpnam; -- The parameter must be a pointer to a string buffer of at least L_tmpnam -- bytes (the call with a null parameter is not supported). The returned -- value, which is just a copy of the input argument, is discarded. diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index 29fe7b48cb0..e2b1ad1d9fd 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2012, 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- -- @@ -120,7 +120,12 @@ package body Prj.Makr is Non_Empty_Node : constant Project_Node_Id := 1; -- Used for the With_Clause of the naming project + -- Turn off warnings for now around this redefinition of True and False, + -- but it really seems a bit horrible to do this redefinition ??? + + pragma Warnings (Off); type Matched_Type is (True, False, Excluded); + pragma Warnings (On); Naming_File_Suffix : constant String := "_naming"; Source_List_File_Suffix : constant String := "_source_list.txt"; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index b0d76661b06..f3ca31bdbf9 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -68,14 +68,21 @@ package Prj is type Yes_No_Unknown is (Yes, No, Unknown); -- Tri-state to decide if -lgnarl is needed when linking + pragma Warnings (Off); type Project_Qualifier is (Unspecified, + + -- The following clash with Standard is OK, and justified by the context + -- which really wants to use the same set of qualifiers. + Standard, + Library, Configuration, Dry, Aggregate, Aggregate_Library); + pragma Warnings (On); -- Qualifiers that can prefix the reserved word "project" in a project -- file: -- Standard: standard project ... @@ -1188,7 +1195,17 @@ package Prj is -- The following record describes a project file representation - type Standalone is (No, Standard, Encapsulated); + pragma Warnings (Off); + type Standalone is + (No, + + -- The following clash with Standard is OK, and justified by the context + -- which really wants to use the same set of qualifiers. + + Standard, + + Encapsulated); + pragma Warnings (On); type Project_Data (Qualifier : Project_Qualifier := Unspecified) is record diff --git a/gcc/ada/s-crtl.ads b/gcc/ada/s-crtl.ads index c02d23023eb..a763d606b70 100644 --- a/gcc/ada/s-crtl.ads +++ b/gcc/ada/s-crtl.ads @@ -177,7 +177,7 @@ package System.CRTL is size : size_t) return int; pragma Import (C, setvbuf, "setvbuf"); - procedure tmpnam (string : chars); + procedure tmpnam (str : chars); pragma Import (C, tmpnam, "tmpnam"); function tmpfile return FILEs; diff --git a/gcc/ada/s-stratt-xdr.adb b/gcc/ada/s-stratt-xdr.adb index 86e190a98b5..d63c2514779 100644 --- a/gcc/ada/s-stratt-xdr.adb +++ b/gcc/ada/s-stratt-xdr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2012, Free Software Foundation, Inc. -- -- -- -- GARLIC 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- -- @@ -374,12 +374,12 @@ package body System.Stream_Attributes is F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Positive : Boolean; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Result : Float; - S : SEA (1 .. F_L); - L : SEO; + Is_Positive : Boolean; + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Result : Float; + S : SEA (1 .. F_L); + L : SEO; begin Ada.Streams.Read (Stream.all, S, L); @@ -397,10 +397,10 @@ package body System.Stream_Attributes is Result := Float'Scaling (Float (Fraction), -F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -434,7 +434,7 @@ package body System.Stream_Attributes is (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -489,12 +489,12 @@ package body System.Stream_Attributes is F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Positive : Boolean; - Exponent : Long_Unsigned; - Fraction : Long_Long_Unsigned; - Result : Long_Float; - S : SEA (1 .. LF_L); - L : SEO; + Is_Positive : Boolean; + Exponent : Long_Unsigned; + Fraction : Long_Long_Unsigned; + Result : Long_Float; + S : SEA (1 .. LF_L); + L : SEO; begin Ada.Streams.Read (Stream.all, S, L); @@ -513,10 +513,10 @@ package body System.Stream_Attributes is Result := Long_Float'Scaling (Long_Float (Fraction), -F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -551,7 +551,7 @@ package body System.Stream_Attributes is (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -617,7 +617,7 @@ package body System.Stream_Attributes is F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Positive : Boolean; + Is_Positive : Boolean; Exponent : Long_Unsigned; Fraction_1 : Long_Long_Unsigned := 0; Fraction_2 : Long_Long_Unsigned := 0; @@ -648,10 +648,10 @@ package body System.Stream_Attributes is Result := Long_Long_Float'Scaling (Result, HF - F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -686,7 +686,7 @@ package body System.Stream_Attributes is (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -827,12 +827,12 @@ package body System.Stream_Attributes is F_Bytes : SEO renames Fields (I).F_Bytes; F_Size : Integer renames Fields (I).F_Size; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Positive : Boolean; - Result : Short_Float; - S : SEA (1 .. SF_L); - L : SEO; + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Is_Positive : Boolean; + Result : Short_Float; + S : SEA (1 .. SF_L); + L : SEO; begin Ada.Streams.Read (Stream.all, S, L); @@ -850,10 +850,10 @@ package body System.Stream_Attributes is Result := Short_Float'Scaling (Short_Float (Fraction), -F_Size); if BS <= S (1) then - Positive := False; + Is_Positive := False; Exponent := Long_Unsigned (S (1) - BS); else - Positive := True; + Is_Positive := True; Exponent := Long_Unsigned (S (1)); end if; @@ -887,7 +887,7 @@ package body System.Stream_Attributes is (1.0 + Result, Integer (Exponent) - E_Bias); end if; - if not Positive then + if not Is_Positive then Result := -Result; end if; @@ -1179,12 +1179,12 @@ package body System.Stream_Attributes is F_Size : Integer renames Fields (I).F_Size; F_Mask : SE renames Fields (I).F_Mask; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Float; - S : SEA (1 .. F_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Float; + S : SEA (1 .. F_L) := (others => 0); begin if not Item'Valid then @@ -1193,7 +1193,7 @@ package body System.Stream_Attributes is -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); F := abs (Item); -- Signed zero @@ -1241,7 +1241,7 @@ package body System.Stream_Attributes is -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; @@ -1293,12 +1293,12 @@ package body System.Stream_Attributes is F_Size : Integer renames Fields (I).F_Size; F_Mask : SE renames Fields (I).F_Mask; - Exponent : Long_Unsigned; - Fraction : Long_Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Long_Float; - S : SEA (1 .. LF_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction : Long_Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Long_Float; + S : SEA (1 .. LF_L) := (others => 0); begin if not Item'Valid then @@ -1307,7 +1307,7 @@ package body System.Stream_Attributes is -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); F := abs (Item); -- Signed zero @@ -1355,7 +1355,7 @@ package body System.Stream_Attributes is -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; @@ -1421,13 +1421,13 @@ package body System.Stream_Attributes is HFS : constant Integer := F_Size / 2; - Exponent : Long_Unsigned; - Fraction_1 : Long_Long_Unsigned; - Fraction_2 : Long_Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Long_Long_Float := Item; - S : SEA (1 .. LLF_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction_1 : Long_Long_Unsigned; + Fraction_2 : Long_Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Long_Long_Float := Item; + S : SEA (1 .. LLF_L) := (others => 0); begin if not Item'Valid then @@ -1436,7 +1436,8 @@ package body System.Stream_Attributes is -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); + if F < 0.0 then F := -Item; end if; @@ -1495,7 +1496,7 @@ package body System.Stream_Attributes is -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; @@ -1639,12 +1640,12 @@ package body System.Stream_Attributes is F_Size : Integer renames Fields (I).F_Size; F_Mask : SE renames Fields (I).F_Mask; - Exponent : Long_Unsigned; - Fraction : Long_Unsigned; - Positive : Boolean; - E : Integer; - F : Short_Float; - S : SEA (1 .. SF_L) := (others => 0); + Exponent : Long_Unsigned; + Fraction : Long_Unsigned; + Is_Positive : Boolean; + E : Integer; + F : Short_Float; + S : SEA (1 .. SF_L) := (others => 0); begin if not Item'Valid then @@ -1653,7 +1654,7 @@ package body System.Stream_Attributes is -- Compute Sign - Positive := (0.0 <= Item); + Is_Positive := (0.0 <= Item); F := abs (Item); -- Signed zero @@ -1701,7 +1702,7 @@ package body System.Stream_Attributes is -- Store Sign - if not Positive then + if not Is_Positive then S (1) := S (1) + BS; end if; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index bb24fc2e21a..490048e9a7c 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -431,11 +431,17 @@ package body Sem_Aux is begin N := First_Rep_Item (E); while Present (N) loop + + -- Only one of Priority / Interrupt_Priority can be specified, so + -- return whichever one is present to catch illegal duplication. + if Nkind (N) = N_Pragma and then (Pragma_Name (N) = Nam or else (Nam = Name_Priority - and then Pragma_Name (N) = Name_Interrupt_Priority)) + and then Pragma_Name (N) = Name_Interrupt_Priority) + or else (Nam = Name_Interrupt_Priority + and then Pragma_Name (N) = Name_Priority)) then if Check_Parents then return N; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 6f2528e2a86..51edb644c1d 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -253,9 +253,7 @@ package body Sem_Ch13 is -- is important, since otherwise if there are record subtypes, we -- could reverse the bits once for each subtype, which is wrong. - if Present (CC) - and then Ekind (R) = E_Record_Type - then + if Present (CC) and then Ekind (R) = E_Record_Type then declare CFB : constant Uint := Component_Bit_Offset (Comp); CSZ : constant Uint := Esize (Comp); @@ -623,14 +621,12 @@ package body Sem_Ch13 is for C in Start .. Stop loop declare Comp : constant Entity_Id := Comps (C); - CC : constant Node_Id := - Component_Clause (Comp); - LB : constant Uint := - Static_Integer (Last_Bit (CC)); + CC : constant Node_Id := Component_Clause (Comp); + + LB : constant Uint := Static_Integer (Last_Bit (CC)); NFB : constant Uint := MSS - Uint_1 - LB; NLB : constant Uint := NFB + Esize (Comp) - 1; - Pos : constant Uint := - Static_Integer (Position (CC)); + Pos : constant Uint := Static_Integer (Position (CC)); begin if Warn_On_Reverse_Bit_Order then @@ -1012,9 +1008,7 @@ package body Sem_Ch13 is procedure Analyze_Aspect_Implicit_Dereference is begin - if not Is_Type (E) - or else not Has_Discriminants (E) - then + if not Is_Type (E) or else not Has_Discriminants (E) then Error_Msg_N ("Aspect must apply to a type with discriminants", N); @@ -1306,7 +1300,8 @@ package body Sem_Ch13 is A_Name := Chars (Identifier (A)); if A_Name = Name_Import - or else A_Name = Name_Export + or else + A_Name = Name_Export then if Found then Error_Msg_N ("conflicting", A); @@ -1331,6 +1326,7 @@ package body Sem_Ch13 is end loop; Arg_List := New_List (Relocate_Node (Expr), Ent); + if Present (L_Assoc) then Append_To (Arg_List, L_Assoc); end if; @@ -1769,9 +1765,7 @@ package body Sem_Ch13 is -- For a Boolean aspect, create the corresponding pragma if -- no expression or if the value is True. - if Is_Boolean_Aspect (Aspect) - and then No (Aitem) - then + if Is_Boolean_Aspect (Aspect) and then No (Aitem) then if Is_True (Static_Boolean (Expr)) then Aitem := Make_Pragma (Loc, @@ -4752,11 +4746,13 @@ package body Sem_Ch13 is or else Intval (Last_Bit (Rep1)) /= Intval (Last_Bit (CC)) then - Error_Msg_N ("component clause inconsistent " - & "with representation of ancestor", CC); + Error_Msg_N + ("component clause inconsistent " + & "with representation of ancestor", CC); elsif Warn_On_Redundant_Constructs then - Error_Msg_N ("?redundant component clause " - & "for inherited component!", CC); + Error_Msg_N + ("?redundant component clause " + & "for inherited component!", CC); end if; end; end if; @@ -5031,9 +5027,10 @@ package body Sem_Ch13 is -- Replace_Type_Reference -- ---------------------------- + -- Note: See comments in Add_Predicates.Replace_Type_Reference + -- regarding handling of Sloc and Comes_From_Source. + procedure Replace_Type_Reference (N : Node_Id) is - -- See comments in Add_Predicates.Replace_Type_Reference regarding - -- Sloc and Comes_From_Source. begin -- Invariant'Class, replace with T'Class (obj) @@ -5145,7 +5142,8 @@ package body Sem_Ch13 is Assoc := New_List ( Make_Pragma_Argument_Association (Loc, Expression => Make_Identifier (Loc, Name_Invariant)), - Make_Pragma_Argument_Association (Loc, Expression => Exp)); + Make_Pragma_Argument_Association (Loc, + Expression => Exp)); -- Add message if present in Invariant pragma @@ -5254,7 +5252,6 @@ package body Sem_Ch13 is -- Build the procedure if we generated at least one Check pragma if Stmts /= No_List then - Spec := Copy_Separate_Tree (Specification (PDecl)); PBody := @@ -5487,7 +5484,6 @@ package body Sem_Ch13 is if Entity (Arg1) = Typ or else Full_View (Entity (Arg1)) = Typ then - -- We have a match, this entry is for our subtype -- We need to replace any occurrences of the name of the @@ -6074,6 +6070,7 @@ package body Sem_Ch13 is -- Comparisons of type with static value when N_Op_Compare => + -- Type is left operand if Is_Type_Ref (Left_Opnd (Exp)) @@ -6336,9 +6333,7 @@ package body Sem_Ch13 is begin -- Not static if type does not have static predicates - if not Has_Predicates (Typ) - or else No (Static_Predicate (Typ)) - then + if not Has_Predicates (Typ) or else No (Static_Predicate (Typ)) then raise Non_Static; end if; @@ -7435,9 +7430,7 @@ package body Sem_Ch13 is -- Check parent overlap if component might overlap parent field - if Present (Tagged_Parent) - and then Fbit <= Parent_Last_Bit - then + if Present (Tagged_Parent) and then Fbit <= Parent_Last_Bit then Pcomp := First_Component_Or_Discriminant (Tagged_Parent); while Present (Pcomp) loop if not Is_Tag (Pcomp) @@ -7599,7 +7592,7 @@ package body Sem_Ch13 is -- Outer level of record definition, check discriminants if Nkind_In (Clist, N_Full_Type_Declaration, - N_Private_Type_Declaration) + N_Private_Type_Declaration) then if Has_Discriminants (Defining_Identifier (Clist)) then C2_Ent := @@ -7951,6 +7944,7 @@ package body Sem_Ch13 is if Asiz <= Siz then return; + else Error_Msg_Uint_1 := Asiz; Error_Msg_NE @@ -8281,11 +8275,12 @@ package body Sem_Ch13 is begin if Nkind (N) /= N_Attribute_Definition_Clause then return False; + else declare - Id : constant Attribute_Id := Get_Attribute_Id (Chars (N)); + Id : constant Attribute_Id := Get_Attribute_Id (Chars (N)); begin - return Id = Attribute_Input + return Id = Attribute_Input or else Id = Attribute_Output or else Id = Attribute_Read or else Id = Attribute_Write @@ -8681,6 +8676,7 @@ package body Sem_Ch13 is elsif Has_Private_Component (T) then if Nkind (N) = N_Pragma then return False; + else Error_Msg_N ("representation item must appear after type is fully defined", @@ -8775,9 +8771,7 @@ package body Sem_Ch13 is -- but avoid chaining if we have an overloadable entity, and the pragma -- is one that can apply to multiple overloaded entities. - if Is_Overloadable (T) - and then Nkind (N) = N_Pragma - then + if Is_Overloadable (T) and then Nkind (N) = N_Pragma then declare Pname : constant Name_Id := Pragma_Name (N); begin @@ -9045,8 +9039,6 @@ package body Sem_Ch13 is begin if Has_Discriminants (T1) then - CD1 := First_Discriminant (T1); - CD2 := First_Discriminant (T2); -- The number of discriminants may be different if the -- derived type has fewer (constrained by values). The @@ -9054,9 +9046,9 @@ package body Sem_Ch13 is -- the original, so the discrepancy does not per se -- indicate a different representation. - while Present (CD1) - and then Present (CD2) - loop + CD1 := First_Discriminant (T1); + CD2 := First_Discriminant (T2); + while Present (CD1) and then Present (CD2) loop if not Same_Rep then return False; else @@ -9068,7 +9060,6 @@ package body Sem_Ch13 is CD1 := First_Component (Underlying_Type (Base_Type (T1))); CD2 := First_Component (Underlying_Type (Base_Type (T2))); - while Present (CD1) loop if not Same_Rep then return False; @@ -9094,7 +9085,6 @@ package body Sem_Ch13 is begin L1 := First_Literal (T1); L2 := First_Literal (T2); - while Present (L1) loop if Enumeration_Rep (L1) /= Enumeration_Rep (L2) then return False; @@ -9105,7 +9095,6 @@ package body Sem_Ch13 is end loop; return True; - end Enumeration_Case; -- Any other types have the same representation for these purposes @@ -9219,7 +9208,6 @@ package body Sem_Ch13 is -- Skip processing of this entry if warning already posted if not Address_Warning_Posted (ACCR.N) then - Expr := Original_Node (Expression (ACCR.N)); -- Get alignments @@ -9353,9 +9341,8 @@ package body Sem_Ch13 is -- Bad component size, check reason if Has_Component_Size_Clause (Atyp) then - P := - Get_Attribute_Definition_Clause - (Atyp, Attribute_Component_Size); + P := Get_Attribute_Definition_Clause + (Atyp, Attribute_Component_Size); if Present (P) then Error_Msg_Sloc := Sloc (P); @@ -9427,7 +9414,8 @@ package body Sem_Ch13 is -- cases where we cannot check static values. if not (Known_Static_Esize (C) - and then Known_Static_Esize (Ctyp)) + and then + Known_Static_Esize (Ctyp)) then return False; end if; @@ -9435,9 +9423,7 @@ package body Sem_Ch13 is -- Size of component must be addressable or greater than 64 bits -- and a multiple of bytes. - if not Addressable (Esize (C)) - and then Esize (C) < Uint_64 - then + if not Addressable (Esize (C)) and then Esize (C) < Uint_64 then return False; end if; @@ -9626,9 +9612,7 @@ package body Sem_Ch13 is -- Source may be unconstrained array, but not target - if Is_Array_Type (Target) - and then not Is_Constrained (Target) - then + if Is_Array_Type (Target) and then not Is_Constrained (Target) then Error_Msg_N ("unchecked conversion to unconstrained array not allowed", N); return; @@ -9674,9 +9658,7 @@ package body Sem_Ch13 is begin pragma Assert (Present (Calendar_Time)); - if Source = Calendar_Time - or else Target = Calendar_Time - then + if Source = Calendar_Time or else Target = Calendar_Time then Error_Msg_N ("?representation of 'Time values may change between " & "'G'N'A'T versions", N); @@ -9691,10 +9673,9 @@ package body Sem_Ch13 is if Warn_On_Unchecked_Conversion then Unchecked_Conversions.Append - (New_Val => UC_Entry' - (Eloc => Sloc (N), - Source => Source, - Target => Target)); + (New_Val => UC_Entry'(Eloc => Sloc (N), + Source => Source, + Target => Target)); -- If both sizes are known statically now, then back end annotation -- is not required to do a proper check but if either size is not @@ -9792,7 +9773,8 @@ package body Sem_Ch13 is Error_Msg_Uint_1 := UI_Abs (Source_Siz - Target_Siz); if Is_Discrete_Type (Source) - and then Is_Discrete_Type (Target) + and then + Is_Discrete_Type (Target) then if Source_Siz > Target_Siz then Error_Msg @@ -9856,7 +9838,8 @@ package body Sem_Ch13 is begin if Known_Alignment (D_Source) - and then Known_Alignment (D_Target) + and then + Known_Alignment (D_Target) then declare Source_Align : constant Uint := Alignment (D_Source); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index ea92eb93295..895af938c4f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -33,6 +33,7 @@ with Expander; use Expander; with Exp_Ch6; use Exp_Ch6; with Exp_Ch7; use Exp_Ch7; with Exp_Ch9; use Exp_Ch9; +with Exp_Dbug; use Exp_Dbug; with Exp_Disp; use Exp_Disp; with Exp_Tss; use Exp_Tss; with Exp_Util; use Exp_Util; @@ -2723,6 +2724,16 @@ package body Sem_Ch6 is Install_Formals (Spec_Id); Last_Real_Spec_Entity := Last_Entity (Spec_Id); + + -- Within an instance, add local renaming declarations so that + -- gdb can retrieve the values of actuals more easily. + + if Is_Generic_Instance (Spec_Id) + and then Is_Wrapper_Package (Current_Scope) + then + Build_Subprogram_Instance_Renamings (N, Current_Scope); + end if; + Push_Scope (Spec_Id); -- Make sure that the subprogram is immediately visible. For diff --git a/gcc/ada/sinfo-cn.adb b/gcc/ada/sinfo-cn.adb index 69b4705ba25..60afa011e4f 100644 --- a/gcc/ada/sinfo-cn.adb +++ b/gcc/ada/sinfo-cn.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, 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- -- @@ -30,8 +30,11 @@ -- general manner, but in some specific cases, the fields of related nodes -- have been deliberately layed out in a manner that permits such alteration. -with Atree; use Atree; -with Snames; use Snames; +with Atree; use Atree; +with Errout; use Errout; +with Sem_Util; use Sem_Util; +with Snames; use Snames; +with Warnsw; use Warnsw; package body Sinfo.CN is @@ -71,6 +74,20 @@ package body Sinfo.CN is procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id) is begin + -- Check for redefinition of standard entity (requiring a warning) + + if Warn_On_Standard_Redefinition then + declare + C : constant Entity_Id := Current_Entity (N); + begin + if Present (C) and then Sloc (C) = Standard_Location then + Error_Msg_N ("redefinition of entity& in Standard?", N); + end if; + end; + end if; + + -- Go ahead with the change + Set_Nkind (N, N_Defining_Identifier); N := Extend_Node (N); end Change_Identifier_To_Defining_Identifier; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index 2f858070340..f5e07063cf0 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -435,6 +435,8 @@ begin Write_Switch_Char ("wxx"); Write_Line ("Enable selected warning modes, xx = list of parameters:"); + Write_Line (" * indicates default setting"); + Write_Line (" + indicates warning flag included in -gnatwa"); Write_Line (" a turn on all info/warnings marked below with +"); Write_Line (" A turn off all optional info/warnings"); Write_Line (" .a*+ turn on warnings for failing assertion"); @@ -472,6 +474,8 @@ begin "(annex J) feature"); Write_Line (" k+ turn on warnings on constant variable"); Write_Line (" K* turn off warnings on constant variable"); + Write_Line (" .k+ turn on warnings for standard redefinition"); + Write_Line (" .K* turn off warnings for standard redefinition"); Write_Line (" l turn on warnings for missing " & "elaboration pragma"); Write_Line (" L* turn off warnings for missing " & @@ -541,8 +545,6 @@ begin "unchecked conversion"); Write_Line (" Z turn off warnings for suspicious " & "unchecked conversion"); - Write_Line (" * indicates default in above list"); - Write_Line (" + indicates warning flag included in -gnatwa"); -- Line for -gnatW switch diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 8e2b1b6a879..7920ac90269 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -87,6 +87,7 @@ package body Warnsw is Warn_On_Record_Holes := True; Warn_On_Redundant_Constructs := True; Warn_On_Reverse_Bit_Order := True; + Warn_On_Standard_Redefinition := True; Warn_On_Suspicious_Contract := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unordered_Enumeration_Type := True; @@ -109,6 +110,12 @@ package body Warnsw is when 'I' => Warn_On_Overlap := False; + when 'k' => + Warn_On_Standard_Redefinition := True; + + when 'K' => + Warn_On_Standard_Redefinition := False; + when 'l' => List_Inherited_Aspects := True; @@ -307,6 +314,7 @@ package body Warnsw is Warn_On_Questionable_Missing_Parens := False; Warn_On_Redundant_Constructs := False; Warn_On_Reverse_Bit_Order := False; + Warn_On_Standard_Redefinition := False; Warn_On_Suspicious_Contract := False; Warn_On_Suspicious_Modulus_Value := False; Warn_On_Unchecked_Conversion := False; diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index 9fd998bf457..f802bb7790a 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2012, 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- -- @@ -47,6 +47,10 @@ package Warnsw is -- set with an explicit size clause. Off by default, set by -gnatw.s (but -- not -gnatwa). + Warn_On_Standard_Redefinition : Boolean := False; + -- Warn when a program defines an identifier that matches a name in + -- Standard. Off by default, set by -gnatw.k (and also by -gnatwa). + ----------------- -- Subprograms -- ----------------- |
