Commit 616547fa by Arnaud Charlet

[multiple changes]

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.

From-SVN: r192919
parent 30ebb114
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
......
......@@ -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,
......
......@@ -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 --
------------------------------------
......
......@@ -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 --
-------------------------------------------
......
......@@ -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.
......
......@@ -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";
......
......@@ -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
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
......@@ -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
......
......@@ -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;
......
......@@ -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
......
......@@ -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;
......
......@@ -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 --
-----------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment