OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2011-08-02  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb, sem_ch5.adb, sem_type.adb, switch-c.adb, switch-c.ads,
	sem_prag.adb, sem_util.adb, sem_util.ads, sem_res.adb, warnsw.ads,
	prepcomp.ads, cstand.adb, stand.ads, a-calfor.adb, s-stusta.adb:
	Minor reformatting.

2011-08-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb: handle properly 'Result when it is a prefix of an
	indexed component.

2011-08-02  Javier Miranda  <miranda@adacore.com>

	* einfo.ads, einfo.adb
	(Original_Access_Type): Move this attribute to Node26 since there was
	an undocumented use of Node21 in E_Access_Subprogram_Type entities
	which causes conflicts and breaks the generation of the .NET compiler.
	(Interface_Name): Add missing documentation on JGNAT only uses of
	this attribute.

From-SVN: r177145
This commit is contained in:
Arnaud Charlet 2011-08-02 15:10:33 +02:00
parent 70c34e1c94
commit ded8909b24
19 changed files with 137 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
gcc/ada/ChangeLog
View File

@ -1,3 +1,24 @@
2011-08-02 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch5.adb, sem_type.adb, switch-c.adb, switch-c.ads,
sem_prag.adb, sem_util.adb, sem_util.ads, sem_res.adb, warnsw.ads,
prepcomp.ads, cstand.adb, stand.ads, a-calfor.adb, s-stusta.adb:
Minor reformatting.
2011-08-02 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb: handle properly 'Result when it is a prefix of an
indexed component.
2011-08-02 Javier Miranda <miranda@adacore.com>
* einfo.ads, einfo.adb
(Original_Access_Type): Move this attribute to Node26 since there was
an undocumented use of Node21 in E_Access_Subprogram_Type entities
which causes conflicts and breaks the generation of the .NET compiler.
(Interface_Name): Add missing documentation on JGNAT only uses of
this attribute.
2011-08-02 Javier Miranda <miranda@adacore.com>
* exp_pakd.adb (Expand_Packed_Element_Reference): Disable this routine

8
gcc/ada/a-calfor.adb
View File

@ -197,7 +197,7 @@ package body Ada.Calendar.Formatting is
Include_Time_Fraction : Boolean := False;
Time_Zone : Time_Zones.Time_Offset := 0) return String
is
To_Char : constant array (0 .. 9) of Character := "0123456789";
To_Char : constant array (0 .. 9) of Character := "0123456789";
Year : Year_Number;
Month : Month_Number;
@ -212,8 +212,8 @@ package body Ada.Calendar.Formatting is
-- The result length depends on whether fractions are requested.
Result : String := "0000-00-00 00:00:00.00";
Last : constant Positive
:= Result'Last - (if Include_Time_Fraction then 0 else 3);
Last : constant Positive :=
Result'Last - (if Include_Time_Fraction then 0 else 3);
begin
Split (Date, Year, Month, Day,
@ -347,7 +347,7 @@ package body Ada.Calendar.Formatting is
begin
-- Validity checks
if not Hour'Valid
if not Hour'Valid
or else not Minute'Valid
or else not Second'Valid
or else not Sub_Second'Valid

7
gcc/ada/cstand.adb
View File

@ -196,14 +196,15 @@ package body CStand is
Set_Size_Known_At_Compile_Time (E);
end Build_Float_Type;
------------------------
------------------------------
-- Find_Back_End_Float_Type --
------------------------
------------------------------
function Find_Back_End_Float_Type (Name : String) return Entity_Id is
N : Elmt_Id := First_Elmt (Back_End_Float_Types);
N : Elmt_Id;
begin
N := First_Elmt (Back_End_Float_Types);
while Present (N) and then Get_Name_String (Chars (Node (N))) /= Name
loop
Next_Elmt (N);

12
gcc/ada/einfo.adb
View File

@ -181,7 +181,6 @@ package body Einfo is
-- Default_Expr_Function Node21
-- Discriminant_Constraint Elist21
-- Interface_Name Node21
-- Original_Access_Type Node21
-- Original_Array_Type Node21
-- Small_Value Ureal21
@ -221,6 +220,7 @@ package body Einfo is
-- Dispatch_Table_Wrappers Elist26
-- Last_Assignment Node26
-- Original_Access_Type Node26
-- Overridden_Operation Node26
-- Package_Instantiation Node26
-- Relative_Deadline_Variable Node26
@ -2357,7 +2357,7 @@ package body Einfo is
function Original_Access_Type (Id : E) return E is
begin
pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
return Node21 (Id);
return Node26 (Id);
end Original_Access_Type;
function Original_Array_Type (Id : E) return E is
@ -4862,7 +4862,7 @@ package body Einfo is
procedure Set_Original_Access_Type (Id : E; V : E) is
begin
pragma Assert (Ekind (Id) = E_Access_Subprogram_Type);
Set_Node21 (Id, V);
Set_Node26 (Id, V);
end Set_Original_Access_Type;
procedure Set_Original_Array_Type (Id : E; V : E) is
@ -8345,9 +8345,6 @@ package body Einfo is
when Fixed_Point_Kind =>
Write_Str ("Small_Value");
when E_Access_Subprogram_Type =>
Write_Str ("Original_Access_Type");
when E_In_Parameter =>
Write_Str ("Default_Expr_Function");
@ -8550,6 +8547,9 @@ package body Einfo is
procedure Write_Field26_Name (Id : Entity_Id) is
begin
case Ekind (Id) is
when E_Access_Subprogram_Type =>
Write_Str ("Original_Access_Type");
when E_Generic_Package |
E_Package =>
Write_Str ("Package_Instantiation");

20
gcc/ada/einfo.ads
View File

@ -1911,12 +1911,13 @@ package Einfo is
-- instantiations.
-- Interface_Name (Node21)
-- Present in exceptions, functions, procedures, variables, constants,
-- and packages. Set to Empty unless an export, import, or interface
-- name pragma has explicitly specified an external name, in which
-- case it references an N_String_Literal node for the specified
-- external name. In the case of exceptions, the field is set by
-- Import_Exception/Export_Exception (which can be used in OpenVMS
-- Present in constants, variables, exceptions, functions, procedures,
-- packages, components (JGNAT only), discriminants (JGNAT only), and
-- access to subprograms (JGNAT only). Set to Empty unless an export,
-- import, or interface name pragma has explicitly specified an external
-- name, in which case it references an N_String_Literal node for the
-- specified external name. In the case of exceptions, the field is set
-- by Import_Exception/Export_Exception (which can be used in OpenVMS
-- versions only). Note that if this field is Empty, and Is_Imported
-- or Is_Exported is set, then the default interface name is the name
-- of the entity, cased in a manner that is appropriate to the system
@ -3206,7 +3207,7 @@ package Einfo is
-- Optimize_Alignment (Off) mode applies to the type/object, then neither
-- of the flags Optimize_Alignment_Space/Optimize_Alignment_Time is set.
-- Original_Access_Type (Node21)
-- Original_Access_Type (Node26)
-- Present in E_Access_Subprogram_Type entities. Set only if the access
-- type was generated by the expander as part of processing an access
-- to protected subprogram type. Points to the access to protected
@ -4882,8 +4883,9 @@ package Einfo is
-- E_Access_Subprogram_Type
-- Equivalent_Type (Node18) (remote types only)
-- Directly_Designated_Type (Node20)
-- Original_Access_Type (Node21)
-- Interface_Name (Node21) (JGNAT usage only)
-- Needs_No_Actuals (Flag22)
-- Original_Access_Type (Node26)
-- Can_Use_Internal_Rep (Flag229)
-- (plus type attributes)
@ -5004,7 +5006,7 @@ package Einfo is
-- Renamed_Object (Node18)
-- Size_Check_Code (Node19) (constants only)
-- Prival_Link (Node20) (privals only)
-- Interface_Name (Node21)
-- Interface_Name (Node21) (constants only)
-- Related_Type (Node27) (constants only)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)

22
gcc/ada/prepcomp.ads
View File

@ -30,15 +30,15 @@ with Namet; use Namet;
package Prepcomp is
procedure Add_Dependencies;
-- Add dependencies on the preprocessing data file and the
-- preprocessing definition files, if any.
-- Add dependencies on the preprocessing data file and the preprocessing
-- definition files, if any.
procedure Check_Symbols;
-- Check if there are preprocessing symbols on the command line and
-- set preprocessing if there are some: all files are preprocessed with
-- these symbols. This procedure should not be called if there is a
-- preprocessing data file specified on the command line. Procedure
-- Parse_Preprocessing_Data_File should be called instead.
-- Check if there are preprocessing symbols on the command line and set
-- preprocessing if there are some: all files are preprocessed with these
-- symbols. This procedure should not be called if there is a preprocessing
-- data file specified on the command line. Instead a call should be made
-- to Parse_Preprocessing_Data_File.
procedure Parse_Preprocessing_Data_File (N : File_Name_Type);
-- Parse a preprocessing data file, specified with a -gnatep= switch
@ -46,10 +46,10 @@ package Prepcomp is
procedure Prepare_To_Preprocess
(Source : File_Name_Type;
Preprocessing_Needed : out Boolean);
-- Prepare, if necessary, the preprocessor for a source file.
-- If the source file needs to be preprocessed, Preprocessing_Needed
-- is set to True. Otherwise, Preprocessing_Needed is set to False
-- and no preprocessing needs to be done.
-- Prepare, if necessary, the preprocessor for a source file. If the source
-- file needs to be preprocessed, Preprocessing_Needed is set to True.
-- Otherwise, Preprocessing_Needed is set to False and no preprocessing
-- needs to be done.
procedure Process_Command_Line_Symbol_Definitions;
-- Check symbol definitions that have been added by calls to procedure

6
gcc/ada/s-stusta.adb
View File

@ -234,8 +234,8 @@ package body System.Stack_Usage.Tasking is
procedure Print (Obj : Stack_Usage_Result) is
Pos : Positive := Obj.Task_Name'Last;
begin
begin
-- Simply trim the string containing the task name
for S in Obj.Task_Name'Range loop
@ -246,8 +246,8 @@ package body System.Stack_Usage.Tasking is
end loop;
declare
T_Name : constant String := Obj.Task_Name
(Obj.Task_Name'First .. Pos);
T_Name : constant String :=
Obj.Task_Name (Obj.Task_Name'First .. Pos);
begin
Put_Line
("| " & T_Name & " | " & Natural'Image (Obj.Max_Size) &

16
gcc/ada/sem_attr.adb
View File

@ -4046,6 +4046,22 @@ package body Sem_Attr is
Error_Attr;
end if;
-- The attribute reference is a primary. If expressions follow,
-- the attribute reference is really an indexable object, so
-- rewrite and analyze as an indexed component.
if Present (E1) then
Rewrite (N,
Make_Indexed_Component (Loc,
Prefix =>
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Prefix (N)),
Attribute_Name => Name_Result),
Expressions => Expressions (N)));
Analyze (N);
return;
end if;
Set_Etype (N, Etype (CS));
-- If several functions with that name are visible,

15
gcc/ada/sem_ch3.adb
View File

@ -15156,7 +15156,10 @@ package body Sem_Ch3 is
declare
Max_Base_Digits : constant Uint :=
Expr_Value (Expression (Parent (RTE (RE_Max_Base_Digits))));
Expr_Value
(Expression
(Parent (RTE (RE_Max_Base_Digits))));
begin
if Digs_Val > Max_Base_Digits then
Error_Msg_Uint_1 := Max_Base_Digits;
@ -17366,15 +17369,15 @@ package body Sem_Ch3 is
Is_Constrained (Priv_Parent)
or else
Nkind (Priv_Indic) = N_Subtype_Indication
or else
Is_Constrained (Entity (Priv_Indic));
or else
Is_Constrained (Entity (Priv_Indic));
Full_Constr : constant Boolean :=
Is_Constrained (Full_Parent)
or else
Nkind (Full_Indic) = N_Subtype_Indication
or else
Is_Constrained (Entity (Full_Indic));
or else
Is_Constrained (Entity (Full_Indic));
Priv_Discr : Entity_Id;
Full_Discr : Entity_Id;
@ -17384,7 +17387,7 @@ package body Sem_Ch3 is
Full_Discr := First_Discriminant (Full_Parent);
while Present (Priv_Discr) and then Present (Full_Discr) loop
if Original_Record_Component (Priv_Discr) =
Original_Record_Component (Full_Discr)
Original_Record_Component (Full_Discr)
or else
Corresponding_Discriminant (Priv_Discr) =
Corresponding_Discriminant (Full_Discr)

12
gcc/ada/sem_ch5.adb
View File

@ -2008,11 +2008,10 @@ package body Sem_Ch5 is
return;
end;
-- Domain of iteration is not a function call, and is
-- side-effect free.
else
-- Domain of iteration is not a function call, and is
-- side-effect free.
Analyze (DS);
end if;
end if;
@ -2210,6 +2209,7 @@ package body Sem_Ch5 is
then
declare
Id : constant Entity_Id := Make_Temporary (Loc, 'R', Container);
Decl : Node_Id;
Assign : Node_Id;
@ -2223,8 +2223,8 @@ package body Sem_Ch5 is
Assign :=
Make_Assignment_Statement (Loc,
Name => New_Occurrence_Of (Id, Loc),
Expression => Relocate_Node (Container));
Name => New_Occurrence_Of (Id, Loc),
Expression => Relocate_Node (Container));
Insert_Actions (Parent (N), New_List (Decl, Assign));
end;

8
gcc/ada/sem_prag.adb
View File

@ -3865,15 +3865,17 @@ package body Sem_Prag is
procedure Process_Import_Predefined_Type is
Loc : constant Source_Ptr := Sloc (N);
Elmt : Elmt_Id := First_Elmt (Predefined_Float_Types);
Elmt : Elmt_Id;
Ftyp : Node_Id := Empty;
Decl : Node_Id;
Def : Node_Id;
Nam : Name_Id;
begin
String_To_Name_Buffer (Strval (Expression (Arg3)));
Nam := Name_Find;
Elmt := First_Elmt (Predefined_Float_Types);
while Present (Elmt) and then Chars (Node (Elmt)) /= Nam loop
Next_Elmt (Elmt);
end loop;
@ -3881,6 +3883,7 @@ package body Sem_Prag is
Ftyp := Node (Elmt);
if Present (Ftyp) then
-- Don't build a derived type declaration, because predefined C
-- types have no declaration anywhere, so cannot really be named.
-- Instead build a full type declaration, starting with an
@ -3893,8 +3896,9 @@ package body Sem_Prag is
Make_Real_Literal (Loc, Realval (Type_Low_Bound (Ftyp))),
Make_Real_Literal (Loc, Realval (Type_High_Bound (Ftyp)))));
-- Should never have a predefined type we cannot handle
else
-- Should never have a predefined type we cannot handle
raise Program_Error;
end if;

5
gcc/ada/sem_res.adb
View File

@ -5739,13 +5739,14 @@ package body Sem_Res is
-- Commented out as the call to Is_Inherited_Operation_For_Type may
-- cause an error because the type entity of the parent node of
-- Entity (Name (N) may not be set.
-- Entity (Name (N) may not be set. ???
-- So why not just add a guard ???
-- if Nkind (N) = N_Function_Call
-- and then Is_Tagged_Type (Etype (N))
-- and then Is_Entity_Name (Name (N))
-- and then Is_Inherited_Operation_For_Type
-- (Entity (Name (N)), Etype (N))
-- (Entity (Name (N)), Etype (N))
-- then
-- Check_Formal_Restriction ("function not inherited", N);
-- end if;

5
gcc/ada/sem_type.adb
View File

@ -832,13 +832,12 @@ package body Sem_Type is
and then Is_Interface (Etype (T1))
and then Is_Concurrent_Type (T2)
and then Interface_Present_In_Ancestor
(Typ => BT2,
Iface => Etype (T1))
(Typ => BT2, Iface => Etype (T1))
then
return True;
-- Ada 2005 (AI-251): A class-wide abstract interface type T1 covers an
-- object T2 implementing T1
-- object T2 implementing T1.
elsif Ada_Version >= Ada_2005
and then Is_Class_Wide_Type (T1)

10
gcc/ada/sem_util.adb
View File

@ -6750,7 +6750,7 @@ package body Sem_Util is
-------------------------------------
function Is_Inherited_Operation_For_Type
(E, Typ : Entity_Id) return Boolean
(E : Entity_Id; Typ : Entity_Id) return Boolean
is
begin
return Is_Inherited_Operation (E)
@ -7373,9 +7373,11 @@ package body Sem_Util is
----------------------------------
function Is_SPARK_Initialization_Expr (N : Node_Id) return Boolean is
Is_Ok : Boolean;
Is_Ok : Boolean;
Expr : Node_Id;
Comp_Assn : Node_Id;
Choice : Node_Id;
Expr, Comp_Assn, Choice : Node_Id;
begin
Is_Ok := True;
@ -7476,7 +7478,7 @@ package body Sem_Util is
Is_Ok := False;
end case;
<<Done>>
<<Done>>
return Is_Ok;
end Is_SPARK_Initialization_Expr;

6
gcc/ada/sem_util.ads
View File

@ -734,8 +734,8 @@ package Sem_Util is
-- if it is False (i.e. zero).
function Is_Fixed_Model_Number (U : Ureal; T : Entity_Id) return Boolean;
-- Returns True iff the number U is a model number of the fixed-
-- point type T, i.e. if it is an exact multiple of Small.
-- Returns True iff the number U is a model number of the fixed-point type
-- T, i.e. if it is an exact multiple of Small.
function Is_Fully_Initialized_Type (Typ : Entity_Id) return Boolean;
-- Typ is a type entity. This function returns true if this type is fully
@ -751,7 +751,7 @@ package Sem_Util is
-- by a derived type declaration.
function Is_Inherited_Operation_For_Type
(E, Typ : Entity_Id) return Boolean;
(E : Entity_Id; Typ : Entity_Id) return Boolean;
-- E is a subprogram. Return True is E is an implicit operation inherited
-- by the derived type declaration for type Typ.

36
gcc/ada/stand.ads
View File

@ -229,8 +229,8 @@ package Stand is
type Standard_Entity_Array_Type is array (Standard_Entity_Type) of Node_Id;
Standard_Entity : Standard_Entity_Array_Type;
-- This array contains pointers to the Defining Identifier nodes for
-- each of the visible entities defined in Standard_Entities_Type. It is
-- This array contains pointers to the Defining Identifier nodes for each
-- of the visible entities defined in Standard_Entities_Type. The array is
-- initialized by the Create_Standard procedure.
Standard_Package_Node : Node_Id;
@ -336,12 +336,12 @@ package Stand is
-- carrying the enumeration literal names.
Standard_A_Char : Entity_Id;
-- Access to character, used as a component of the exception type to
-- denote a thin pointer component.
-- Access to character, used as a component of the exception type to denote
-- a thin pointer component.
Standard_Debug_Renaming_Type : Entity_Id;
-- A zero-size subtype of Integer, used as the type of variables used
-- to provide the debugger with name encodings for renaming declarations.
-- A zero-size subtype of Integer, used as the type of variables used to
-- provide the debugger with name encodings for renaming declarations.
Predefined_Float_Types : Elist_Id;
-- Entities for predefined floating point types. These are used by
@ -395,9 +395,9 @@ package Stand is
-- Used to represent some unknown integer type
Any_Modular : Entity_Id;
-- Used to represent the result type of a boolean operation on an
-- integer literal. The result is not Universal_Integer, because it is
-- only legal in a modular context.
-- Used to represent the result type of a boolean operation on an integer
-- literal. The result is not Universal_Integer, because it is only legal
-- in a modular context.
Any_Numeric : Entity_Id;
-- Used to represent some unknown numeric type
@ -409,10 +409,10 @@ package Stand is
-- Used to represent some unknown scalar type
Any_String : Entity_Id;
-- The type Any_String is used for string literals before type
-- resolution. It corresponds to array (Positive range <>) of character
-- where the component type is compatible with any character type,
-- not just Standard_Character.
-- The type Any_String is used for string literals before type resolution.
-- It corresponds to array (Positive range <>) of character where the
-- component type is compatible with any character type, not just
-- Standard_Character.
Universal_Integer : Entity_Id;
-- Entity for universal integer type. The bounds of this type correspond
@ -438,9 +438,9 @@ package Stand is
Standard_Integer_16 : Entity_Id;
Standard_Integer_32 : Entity_Id;
Standard_Integer_64 : Entity_Id;
-- These are signed integer types with the indicated sizes, They are
-- used for the underlying implementation types for fixed-point and
-- enumeration types.
-- These are signed integer types with the indicated sizes, They are used
-- for the underlying implementation types for fixed-point and enumeration
-- types.
Standard_Unsigned : Entity_Id;
-- An unsigned type of the same size as Standard_Integer
@ -465,7 +465,7 @@ package Stand is
-- initialization that is carried out by Create_Standard.
procedure Tree_Write;
-- Writes out the entity values in this package to the current
-- tree file using Osint.Tree_Write.
-- Writes out the entity values in this package to the current tree file
-- using Osint.Tree_Write.
end Stand;

4
gcc/ada/switch-c.adb
View File

@ -82,8 +82,8 @@ package body Switch.C is
end if;
Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last)
:= new String'(Def);
Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
new String'(Def);
end Add_Symbol_Definition;
-----------------------------

9
gcc/ada/switch-c.ads
View File

@ -24,10 +24,11 @@
------------------------------------------------------------------------------
-- This package scans front end switches. Note that the body of Usage must be
-- coordinated with the switches that are recognized by this package.
-- The Usage package also acts as the official documentation for the
-- switches that are recognized. In addition, package Debug documents
-- the otherwise undocumented debug switches that are also recognized.
-- be coordinated with the switches that are recognized by this package.
-- The Usage package also acts as the official documentation for the switches
-- that are recognized. In addition, package Debug documents the otherwise
-- undocumented debug switches that are also recognized.
with System.Strings; use System.Strings;

2
gcc/ada/warnsw.ads
View File

@ -23,7 +23,7 @@
-- --
------------------------------------------------------------------------------
-- This unit contains the routines used to handle setting of warning options.
-- This unit contains the routines used to handle setting of warning options
package Warnsw is