+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
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,
-- --
-- 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- --
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 --
------------------------------------
-- 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 --
-------------------------------------------
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.
-- --
-- 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- --
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";
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 ...
-- 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
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;
-- --
-- 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- --
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);
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;
(1.0 + Result, Integer (Exponent) - E_Bias);
end if;
- if not Positive then
+ if not Is_Positive then
Result := -Result;
end if;
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);
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;
(1.0 + Result, Integer (Exponent) - E_Bias);
end if;
- if not Positive then
+ if not Is_Positive then
Result := -Result;
end if;
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;
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;
(1.0 + Result, Integer (Exponent) - E_Bias);
end if;
- if not Positive then
+ if not Is_Positive then
Result := -Result;
end if;
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);
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;
(1.0 + Result, Integer (Exponent) - E_Bias);
end if;
- if not Positive then
+ if not Is_Positive then
Result := -Result;
end if;
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
-- Compute Sign
- Positive := (0.0 <= Item);
+ Is_Positive := (0.0 <= Item);
F := abs (Item);
-- Signed zero
-- Store Sign
- if not Positive then
+ if not Is_Positive then
S (1) := S (1) + BS;
end if;
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
-- Compute Sign
- Positive := (0.0 <= Item);
+ Is_Positive := (0.0 <= Item);
F := abs (Item);
-- Signed zero
-- Store Sign
- if not Positive then
+ if not Is_Positive then
S (1) := S (1) + BS;
end if;
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
-- Compute Sign
- Positive := (0.0 <= Item);
+ Is_Positive := (0.0 <= Item);
+
if F < 0.0 then
F := -Item;
end if;
-- Store Sign
- if not Positive then
+ if not Is_Positive then
S (1) := S (1) + BS;
end if;
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
-- Compute Sign
- Positive := (0.0 <= Item);
+ Is_Positive := (0.0 <= Item);
F := abs (Item);
-- Signed zero
-- Store Sign
- if not Positive then
+ if not Is_Positive then
S (1) := S (1) + BS;
end if;
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;
-- 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);
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
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);
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);
end loop;
Arg_List := New_List (Relocate_Node (Expr), Ent);
+
if Present (L_Assoc) then
Append_To (Arg_List, L_Assoc);
end if;
-- 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,
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;
-- 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)
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
-- Build the procedure if we generated at least one Check pragma
if Stmts /= No_List then
-
Spec := Copy_Separate_Tree (Specification (PDecl));
PBody :=
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
-- Comparisons of type with static value
when N_Op_Compare =>
+
-- Type is left operand
if Is_Type_Ref (Left_Opnd (Exp))
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;
-- 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)
-- 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 :=
if Asiz <= Siz then
return;
+
else
Error_Msg_Uint_1 := Asiz;
Error_Msg_NE
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
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",
-- 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
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
-- 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
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;
begin
L1 := First_Literal (T1);
L2 := First_Literal (T2);
-
while Present (L1) loop
if Enumeration_Rep (L1) /= Enumeration_Rep (L2) then
return False;
end loop;
return True;
-
end Enumeration_Case;
-- Any other types have the same representation for these purposes
-- 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
-- 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);
-- 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;
-- 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;
-- 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;
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);
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
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
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);
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;
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
-- --
-- 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- --
-- 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
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;
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");
"(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 " &
"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
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;
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;
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;
-- --
-- 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- --
-- 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 --
-----------------
projects / platform / upstream / gcc.git / commitdiff