Commit c7f0d2c0 by Arnaud Charlet

[multiple changes]

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

	* atree.ads: Minor reformatting.

2011-08-01  Emmanuel Briot  <briot@adacore.com>

	* g-expect.adb (Get_Command_Output): Fix memory leak.

2011-08-01  Geert Bosch  <bosch@adacore.com>

	* cstand.adb (P_Float_Type): New procedure to print the definition of
	predefined fpt types.
	(P_Mixed_Name): New procedure to print a name using mixed case
	(Print_Standard): Use P_Float_Type for printing floating point types
	* einfo.adb (Machine_Emax_Value): Add preliminary support for quad
	precision IEEE float.

2011-08-01  Thomas Quinot  <quinot@adacore.com>

	* sem_ch3.adb: Minor reformatting.

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

	* sem_ch6.adb (Analyze_Parameterized_Expression): If the expression is
	the completion of a generic function, insert the new body rather than
	rewriting the original.

2011-08-01  Yannick Moy  <moy@adacore.com>

	* sinfo.ads, errout.ads: Typos in comments.

From-SVN: r177028
parent 1c54829e
2011-08-01 Robert Dewar <dewar@adacore.com> 2011-08-01 Robert Dewar <dewar@adacore.com>
* atree.ads: Minor reformatting.
2011-08-01 Emmanuel Briot <briot@adacore.com>
* g-expect.adb (Get_Command_Output): Fix memory leak.
2011-08-01 Geert Bosch <bosch@adacore.com>
* cstand.adb (P_Float_Type): New procedure to print the definition of
predefined fpt types.
(P_Mixed_Name): New procedure to print a name using mixed case
(Print_Standard): Use P_Float_Type for printing floating point types
* einfo.adb (Machine_Emax_Value): Add preliminary support for quad
precision IEEE float.
2011-08-01 Thomas Quinot <quinot@adacore.com>
* sem_ch3.adb: Minor reformatting.
2011-08-01 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Parameterized_Expression): If the expression is
the completion of a generic function, insert the new body rather than
rewriting the original.
2011-08-01 Yannick Moy <moy@adacore.com>
* sinfo.ads, errout.ads: Typos in comments.
2011-08-01 Robert Dewar <dewar@adacore.com>
* par-endh.adb: Minor reformatting. * par-endh.adb: Minor reformatting.
2011-08-01 Robert Dewar <dewar@adacore.com> 2011-08-01 Robert Dewar <dewar@adacore.com>
......
...@@ -890,7 +890,7 @@ package Atree is ...@@ -890,7 +890,7 @@ package Atree is
package Unchecked_Access is package Unchecked_Access is
-- Functions to allow interpretation of Union_Id values as Uint and -- Functions to allow interpretation of Union_Id values as Uint and
-- Ureal values -- Ureal values.
function To_Union is new Unchecked_Conversion (Uint, Union_Id); function To_Union is new Unchecked_Conversion (Uint, Union_Id);
function To_Union is new Unchecked_Conversion (Ureal, Union_Id); function To_Union is new Unchecked_Conversion (Ureal, Union_Id);
......
...@@ -1673,6 +1673,12 @@ package body CStand is ...@@ -1673,6 +1673,12 @@ package body CStand is
procedure P_Float_Range (Id : Entity_Id); procedure P_Float_Range (Id : Entity_Id);
-- Prints the bounds range for the given float type entity -- Prints the bounds range for the given float type entity
procedure P_Float_Type (Id : Entity_Id);
-- Prints the type declaration of the given float type entity
procedure P_Mixed_Name (Id : Name_Id);
-- Prints Id in mixed case
------------------- -------------------
-- P_Float_Range -- -- P_Float_Range --
------------------- -------------------
...@@ -1687,6 +1693,26 @@ package body CStand is ...@@ -1687,6 +1693,26 @@ package body CStand is
Write_Eol; Write_Eol;
end P_Float_Range; end P_Float_Range;
------------------
-- P_Float_Type --
------------------
procedure P_Float_Type (Id : Entity_Id) is
begin
Write_Str (" type ");
P_Mixed_Name (Chars (Id));
Write_Str (" is digits ");
Write_Int (UI_To_Int (Digits_Value (Id)));
Write_Eol;
P_Float_Range (Id);
Write_Str (" for ");
P_Mixed_Name (Chars (Id));
Write_Str ("'Size use ");
Write_Int (UI_To_Int (RM_Size (Id)));
Write_Line (";");
Write_Eol;
end P_Float_Type;
----------------- -----------------
-- P_Int_Range -- -- P_Int_Range --
----------------- -----------------
...@@ -1702,6 +1728,23 @@ package body CStand is ...@@ -1702,6 +1728,23 @@ package body CStand is
Write_Eol; Write_Eol;
end P_Int_Range; end P_Int_Range;
------------------
-- P_Mixed_Name --
------------------
procedure P_Mixed_Name (Id : Name_Id) is
begin
Get_Name_String (Id);
for J in 1 .. Name_Len loop
if J = 1 or else Name_Buffer (J - 1) = '_' then
Name_Buffer (J) := Fold_Upper (Name_Buffer (J));
end if;
end loop;
Write_Str (Name_Buffer (1 .. Name_Len));
end P_Mixed_Name;
-- Start of processing for Print_Standard -- Start of processing for Print_Standard
begin begin
...@@ -1764,41 +1807,10 @@ package body CStand is ...@@ -1764,41 +1807,10 @@ package body CStand is
-- Floating point types -- Floating point types
Write_Str (" type Short_Float is digits "); P_Float_Type (Standard_Short_Float);
Write_Int (Standard_Short_Float_Digits); P_Float_Type (Standard_Float);
Write_Eol; P_Float_Type (Standard_Long_Float);
P_Float_Range (Standard_Short_Float); P_Float_Type (Standard_Long_Long_Float);
Write_Str (" for Short_Float'Size use ");
Write_Int (Standard_Short_Float_Size);
P (";");
Write_Eol;
Write_Str (" type Float is digits ");
Write_Int (Standard_Float_Digits);
Write_Eol;
P_Float_Range (Standard_Float);
Write_Str (" for Float'Size use ");
Write_Int (Standard_Float_Size);
P (";");
Write_Eol;
Write_Str (" type Long_Float is digits ");
Write_Int (Standard_Long_Float_Digits);
Write_Eol;
P_Float_Range (Standard_Long_Float);
Write_Str (" for Long_Float'Size use ");
Write_Int (Standard_Long_Float_Size);
P (";");
Write_Eol;
Write_Str (" type Long_Long_Float is digits ");
Write_Int (Standard_Long_Long_Float_Digits);
Write_Eol;
P_Float_Range (Standard_Long_Long_Float);
Write_Str (" for Long_Long_Float'Size use ");
Write_Int (Standard_Long_Long_Float_Size);
P (";");
Write_Eol;
P (" type Character is (...)"); P (" type Character is (...)");
Write_Str (" for Character'Size use "); Write_Str (" for Character'Size use ");
......
...@@ -6518,7 +6518,7 @@ package body Einfo is ...@@ -6518,7 +6518,7 @@ package body Einfo is
case Digs is case Digs is
when 1 .. 6 => return Uint_128; when 1 .. 6 => return Uint_128;
when 7 .. 15 => return 2**10; when 7 .. 15 => return 2**10;
when 16 .. 18 => return 2**14; when 16 .. 33 => return 2**14;
when others => return No_Uint; when others => return No_Uint;
end case; end case;
......
...@@ -679,8 +679,7 @@ package Errout is ...@@ -679,8 +679,7 @@ package Errout is
-- error messages from the analyzer). The message text may contain a -- error messages from the analyzer). The message text may contain a
-- single & insertion, which will reference the given node. The message is -- single & insertion, which will reference the given node. The message is
-- suppressed if the node N already has a message posted, or if it is a -- suppressed if the node N already has a message posted, or if it is a
-- warning and warnings and N is an entity node for which warnings are -- warning and N is an entity node for which warnings are suppressed.
-- suppressed.
procedure Error_Msg_F (Msg : String; N : Node_Id); procedure Error_Msg_F (Msg : String; N : Node_Id);
-- Similar to Error_Msg_N except that the message is placed on the first -- Similar to Error_Msg_N except that the message is placed on the first
......
...@@ -946,6 +946,7 @@ package body GNAT.Expect is ...@@ -946,6 +946,7 @@ package body GNAT.Expect is
end; end;
if Last = 0 then if Last = 0 then
Free (Output);
return ""; return "";
end if; end if;
......
...@@ -3592,8 +3592,8 @@ package body Sem_Ch3 is ...@@ -3592,8 +3592,8 @@ package body Sem_Ch3 is
Check_Restriction (No_Local_Timing_Events, N); Check_Restriction (No_Local_Timing_Events, N);
end if; end if;
<<Leave>> <<Leave>>
Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
end Analyze_Object_Declaration; end Analyze_Object_Declaration;
--------------------------- ---------------------------
......
...@@ -1070,15 +1070,20 @@ package body Sem_Ch6 is ...@@ -1070,15 +1070,20 @@ package body Sem_Ch6 is
-------------------------------------- --------------------------------------
procedure Analyze_Parameterized_Expression (N : Node_Id) is procedure Analyze_Parameterized_Expression (N : Node_Id) is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
LocX : constant Source_Ptr := Sloc (Expression (N)); LocX : constant Source_Ptr := Sloc (Expression (N));
Def_Id : constant Entity_Id := Defining_Entity (Specification (N));
Prev : constant Entity_Id := Current_Entity_In_Scope (Def_Id);
-- If the expression is a completion, Prev is the entity whose
-- declaration is completed.
New_Body : Node_Id;
begin begin
-- This is one of the occasions on which we write things during semantic -- This is one of the occasions on which we transform the tree during
-- analysis. Transform the parameterized expression into an equivalent -- semantic analysis. Transform the parameterized expression into an
-- subprogram body, and then analyze that. -- equivalent subprogram body, and then analyze that.
Rewrite (N, New_Body :=
Make_Subprogram_Body (Loc, Make_Subprogram_Body (Loc,
Specification => Specification (N), Specification => Specification (N),
Declarations => Empty_List, Declarations => Empty_List,
...@@ -1086,8 +1091,27 @@ package body Sem_Ch6 is ...@@ -1086,8 +1091,27 @@ package body Sem_Ch6 is
Make_Handled_Sequence_Of_Statements (LocX, Make_Handled_Sequence_Of_Statements (LocX,
Statements => New_List ( Statements => New_List (
Make_Simple_Return_Statement (LocX, Make_Simple_Return_Statement (LocX,
Expression => Expression (N)))))); Expression => Expression (N)))));
Analyze (N);
if Present (Prev)
and then Ekind (Prev) = E_Generic_Function
then
-- If the expression completes a generic subprogram, we must create
-- a separate node for the body, because at instantiation the
-- original node of the generic copy must be a generic subprogram
-- body, and cannot be a parameterized expression. Otherwise we
-- just rewrite the expression with the non-generic body.
Insert_After (N, New_Body);
Rewrite (N, Make_Null_Statement (Loc));
Analyze (N);
Analyze (New_Body);
else
Rewrite (N, New_Body);
Analyze (N);
end if;
end Analyze_Parameterized_Expression; end Analyze_Parameterized_Expression;
---------------------------- ----------------------------
......
...@@ -7447,7 +7447,7 @@ package Sinfo is ...@@ -7447,7 +7447,7 @@ package Sinfo is
N_Empty, N_Empty,
N_Pragma_Argument_Association, N_Pragma_Argument_Association,
-- N_Has_Etype -- N_Has_Etype, N_Has_Chars
N_Error, N_Error,
...@@ -7680,7 +7680,7 @@ package Sinfo is ...@@ -7680,7 +7680,7 @@ package Sinfo is
N_Code_Statement, N_Code_Statement,
N_Conditional_Entry_Call, N_Conditional_Entry_Call,
-- N_Statement_Other_Than_Procedure_Call. N_Delay_Statement -- N_Statement_Other_Than_Procedure_Call, N_Delay_Statement
N_Delay_Relative_Statement, N_Delay_Relative_Statement,
N_Delay_Until_Statement, N_Delay_Until_Statement,
......
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