+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.
package Unchecked_Access is
-- 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 (Ureal, Union_Id);
procedure P_Float_Range (Id : Entity_Id);
-- 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 --
-------------------
Write_Eol;
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 --
-----------------
Write_Eol;
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
begin
-- Floating point types
- Write_Str (" type Short_Float is digits ");
- Write_Int (Standard_Short_Float_Digits);
- Write_Eol;
- P_Float_Range (Standard_Short_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_Float_Type (Standard_Short_Float);
+ P_Float_Type (Standard_Float);
+ P_Float_Type (Standard_Long_Float);
+ P_Float_Type (Standard_Long_Long_Float);
P (" type Character is (...)");
Write_Str (" for Character'Size use ");
case Digs is
when 1 .. 6 => return Uint_128;
when 7 .. 15 => return 2**10;
- when 16 .. 18 => return 2**14;
+ when 16 .. 33 => return 2**14;
when others => return No_Uint;
end case;
-- error messages from the analyzer). The message text may contain a
-- 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
- -- warning and warnings and N is an entity node for which warnings are
- -- suppressed.
+ -- warning and N is an entity node for which warnings are suppressed.
procedure Error_Msg_F (Msg : String; N : Node_Id);
-- Similar to Error_Msg_N except that the message is placed on the first
end;
if Last = 0 then
+ Free (Output);
return "";
end if;
Check_Restriction (No_Local_Timing_Events, N);
end if;
- <<Leave>>
- Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
+ <<Leave>>
+ Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N));
end Analyze_Object_Declaration;
---------------------------
--------------------------------------
procedure Analyze_Parameterized_Expression (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- LocX : constant Source_Ptr := Sloc (Expression (N));
-
+ Loc : constant Source_Ptr := Sloc (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
- -- This is one of the occasions on which we write things during semantic
- -- analysis. Transform the parameterized expression into an equivalent
- -- subprogram body, and then analyze that.
+ -- This is one of the occasions on which we transform the tree during
+ -- semantic analysis. Transform the parameterized expression into an
+ -- equivalent subprogram body, and then analyze that.
- Rewrite (N,
+ New_Body :=
Make_Subprogram_Body (Loc,
Specification => Specification (N),
Declarations => Empty_List,
Make_Handled_Sequence_Of_Statements (LocX,
Statements => New_List (
Make_Simple_Return_Statement (LocX,
- Expression => Expression (N))))));
- Analyze (N);
+ Expression => Expression (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;
----------------------------
N_Empty,
N_Pragma_Argument_Association,
- -- N_Has_Etype
+ -- N_Has_Etype, N_Has_Chars
N_Error,
N_Code_Statement,
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_Until_Statement,
projects / gcc.git / commitdiff