From c7f0d2c0c5f24657874d7a4adeb504b3fe6c1f6f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Aug 2011 15:17:49 +0200 Subject: [multiple changes] 2011-08-01 Robert Dewar * atree.ads: Minor reformatting. 2011-08-01 Emmanuel Briot * g-expect.adb (Get_Command_Output): Fix memory leak. 2011-08-01 Geert Bosch * 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 * sem_ch3.adb: Minor reformatting. 2011-08-01 Ed Schonberg * 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 * sinfo.ads, errout.ads: Typos in comments. From-SVN: r177028 --- gcc/ada/ChangeLog | 31 ++++++++++++++++++++ gcc/ada/atree.ads | 2 +- gcc/ada/cstand.adb | 82 ++++++++++++++++++++++++++++++---------------------- gcc/ada/einfo.adb | 2 +- gcc/ada/errout.ads | 3 +- gcc/ada/g-expect.adb | 1 + gcc/ada/sem_ch3.adb | 4 +-- gcc/ada/sem_ch6.adb | 42 +++++++++++++++++++++------ gcc/ada/sinfo.ads | 4 +-- 9 files changed, 119 insertions(+), 52 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e73a3cd..cabde81 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,36 @@ 2011-08-01 Robert Dewar + * atree.ads: Minor reformatting. + +2011-08-01 Emmanuel Briot + + * g-expect.adb (Get_Command_Output): Fix memory leak. + +2011-08-01 Geert Bosch + + * 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 + + * sem_ch3.adb: Minor reformatting. + +2011-08-01 Ed Schonberg + + * 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 + + * sinfo.ads, errout.ads: Typos in comments. + +2011-08-01 Robert Dewar + * par-endh.adb: Minor reformatting. 2011-08-01 Robert Dewar diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index ccd4ac2..dbdd93a 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -890,7 +890,7 @@ package Atree is 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); diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb index 8d9d798..d93d96c 100644 --- a/gcc/ada/cstand.adb +++ b/gcc/ada/cstand.adb @@ -1673,6 +1673,12 @@ package body CStand is 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 -- ------------------- @@ -1687,6 +1693,26 @@ package body CStand is 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 -- ----------------- @@ -1702,6 +1728,23 @@ package body CStand is 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 @@ -1764,41 +1807,10 @@ package body CStand is -- 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 "); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 5e9731c..a8b5913 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -6518,7 +6518,7 @@ package body Einfo is 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; diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 1dc2279..ea2600a 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -679,8 +679,7 @@ package Errout is -- 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 diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index c8b368f..8e1af05 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -946,6 +946,7 @@ package body GNAT.Expect is end; if Last = 0 then + Free (Output); return ""; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 0587b9a..c686e90 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3592,8 +3592,8 @@ package body Sem_Ch3 is Check_Restriction (No_Local_Timing_Events, N); end if; - <> - Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); + <> + Analyze_Aspect_Specifications (N, Id, Aspect_Specifications (N)); end Analyze_Object_Declaration; --------------------------- diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 625fc4e..5b87a11 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -1070,15 +1070,20 @@ package body Sem_Ch6 is -------------------------------------- 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, @@ -1086,8 +1091,27 @@ package body Sem_Ch6 is 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; ---------------------------- diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 98ffd77..844e310 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -7447,7 +7447,7 @@ package Sinfo is N_Empty, N_Pragma_Argument_Association, - -- N_Has_Etype + -- N_Has_Etype, N_Has_Chars N_Error, @@ -7680,7 +7680,7 @@ package Sinfo is 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, -- cgit v1.1