diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 38 | ||||
| -rw-r--r-- | gcc/ada/g-comlin.adb | 13 | ||||
| -rw-r--r-- | gcc/ada/impunit.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 113 | ||||
| -rw-r--r-- | gcc/ada/ug_words | 1 | ||||
| -rw-r--r-- | gcc/ada/uintp.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/urealp.adb | 134 | ||||
| -rw-r--r-- | gcc/ada/vms_data.ads | 10 |
10 files changed, 290 insertions, 50 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 556c9b5239d..5d4d7b88f24 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,41 @@ +2010-10-21 Ed Schonberg <schonberg@adacore.com> + + * sem_ch6.adb (Enter_Overloaded_Entity): Refine warning message about + hiding, to remove noise warnings about hiding predefined operators. + +2010-10-21 Emmanuel Briot <briot@adacore.com> + + * g-comlin.adb (Add_Switch): Fix handling of switches with no separator + when the parameter has length 1. + +2010-10-21 Jose Ruiz <ruiz@adacore.com> + + * sem_prag.adb (Set_Ravenscar_Profile): Enforce the restrictions of no + dependence on Ada.Execution_Time.Timers, + Ada.Execution_Time.Group_Budget, and + System.Multiprocessors.Dispatching_Domains which are part of the + Ravenscar Profile. + * impunit.adb (Non_Imp_File_Names_05): Add the file "a-etgrbu" to the + list of Ada 2005 files for package Ada.Execution_Time.Group_Budgets. + (Non_Imp_File_Names_12): Add the file "s-mudido" to the list of Ada 2012 + files for package System.Mutiprocessors.Dispatching_Domains. + +2010-10-21 Tristan Gingold <gingold@adacore.com> + + * ug_words, vms_data.ads: Define the VMS qualifier for -gnateE. + +2010-10-21 Thomas Quinot <quinot@adacore.com> + + * sem_ch3.ads (Process_Discriminants): Clarify cases where this is + called for a completion. + +2010-10-21 Geert Bosch <bosch@adacore.com> + + * uintp.ads: Expand image buffer to have enough room for 128-bit values + * urealp.ads (UR_Write): Write constants in base 16 in hexadecimal + notation; either as fixed point literal or in canonical radix 16 + floating point form. + 2010-10-21 Robert Dewar <dewar@adacore.com> * a-cgaaso.ads, a-tags.ads, exp_ch3.adb, exp_attr.adb, exp_ch4.adb, diff --git a/gcc/ada/g-comlin.adb b/gcc/ada/g-comlin.adb index eb7ebb44dc4..e93042d9614 100644 --- a/gcc/ada/g-comlin.adb +++ b/gcc/ada/g-comlin.adb @@ -2109,14 +2109,21 @@ package body GNAT.Command_Line is Index : Integer) is pragma Unreferenced (Index); + Sep : Character; begin + if Separator = "" then + Sep := ASCII.NUL; + else + Sep := Separator (Separator'First); + end if; + if Cmd.Expanded = null then Cmd.Expanded := new Argument_List'(1 .. 1 => new String'(Simple)); if Param /= "" then Cmd.Params := - new Argument_List'(1 .. 1 => new String'(Separator & Param)); + new Argument_List'(1 .. 1 => new String'(Sep & Param)); else Cmd.Params := new Argument_List'(1 .. 1 => null); end if; @@ -2137,7 +2144,7 @@ package body GNAT.Command_Line is ((Cmd.Params (C) = null and then Param = "") or else (Cmd.Params (C) /= null - and then Cmd.Params (C).all = Separator & Param)) + and then Cmd.Params (C).all = Sep & Param)) and then ((Cmd.Sections (C) = null and then Section = "") or else @@ -2156,7 +2163,7 @@ package body GNAT.Command_Line is if Param /= "" then Add (Cmd.Params, - new String'(Separator & Param), + new String'(Sep & Param), Add_Before); else Add diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index e49d096c1c3..e2111953859 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -394,6 +394,7 @@ package body Impunit is "a-disedf", -- Ada.Dispatching.EDF "a-dispat", -- Ada.Dispatching "a-envvar", -- Ada.Environment_Variables + "a-etgrbu", -- Ada.Execution_Time.Group_Budgets "a-exetim", -- Ada.Execution_Time "a-extiti", -- Ada.Execution_Time.Timers "a-izteio", -- Ada.Integer_Wide_Wide_Text_IO @@ -504,7 +505,8 @@ package body Impunit is -- The following units should be used only in Ada 2012 mode Non_Imp_File_Names_12 : constant File_List := ( - 0 => "s-multip"); -- System.Mutiprocessors + "s-multip", -- System.Multiprocessors + "s-mudido"); -- System.Multiprocessors.Dispatching_Domains ----------------------- -- Alternative Units -- diff --git a/gcc/ada/sem_ch3.ads b/gcc/ada/sem_ch3.ads index 57da53272fa..46605b3716c 100644 --- a/gcc/ada/sem_ch3.ads +++ b/gcc/ada/sem_ch3.ads @@ -277,6 +277,10 @@ package Sem_Ch3 is -- Process the discriminants contained in an N_Full_Type_Declaration or -- N_Incomplete_Type_Decl node N. If the declaration is a completion, -- Prev is entity on the partial view, on which references are posted. + -- However, note that Process_Discriminants is called for a completion only + -- if partial view had no discriminants (else we just check conformance + -- between the two views and do not call Process_Discriminants again for + -- the completion). function Replace_Anonymous_Access_To_Protected_Subprogram (N : Node_Id) return Entity_Id; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 4fb85b60406..0f2fce8dc0b 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -5914,15 +5914,30 @@ package body Sem_Ch6 is E := Homonym (E); exit when No (E); - -- Warn unless genuine overloading + -- Warn unless genuine overloading. Do not emit warning on + -- hiding predefined operators in Standard (these are either an + -- (artifact of our implicit declarations, or simple noise) but + -- keep warning on a operator defined on a local subtype, because + -- of the real danger that different operators may be applied in + -- various parts of the program. if (not Is_Overloadable (E) or else Subtype_Conformant (E, S)) and then (Is_Immediately_Visible (E) or else Is_Potentially_Use_Visible (S)) then - Error_Msg_Sloc := Sloc (E); - Error_Msg_N ("declaration of & hides one#?", S); + if Scope (E) /= Standard_Standard then + Error_Msg_Sloc := Sloc (E); + Error_Msg_N ("declaration of & hides one#?", S); + + elsif Nkind (S) = N_Defining_Operator_Symbol + and then + Scope ( + Base_Type (Etype (First_Formal (S)))) /= Scope (S) + then + Error_Msg_N + ("declaration of & hides predefined operator?", S); + end if; end if; end loop; end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 54546f04bc3..ea8bb10140d 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5410,7 +5410,20 @@ package body Sem_Prag is -- Set required restrictions (see System.Rident for detailed list) + -- Set the No_Dependence rules + -- No_Dependence => Ada.Asynchronous_Task_Control + -- No_Dependence => Ada.Calendar + -- No_Dependence => Ada.Execution_Time.Group_Budget + -- No_Dependence => Ada.Execution_Time.Timers + -- No_Dependence => Ada.Task_Attributes + -- No_Dependence => System.Multiprocessors.Dispatching_Domains + procedure Set_Ravenscar_Profile (N : Node_Id) is + Prefix_Entity : Entity_Id; + Selector_Entity : Entity_Id; + Prefix_Node : Node_Id; + Node : Node_Id; + begin -- pragma Task_Dispatching_Policy (FIFO_Within_Priorities) @@ -5459,6 +5472,106 @@ package body Sem_Prag is Set_Profile_Restrictions (Ravenscar, N, Warn => Treat_Restrictions_As_Warnings); + + -- Set the No_Dependence restrictions + + -- The following No_Dependence restrictions: + -- No_Dependence => Ada.Asynchronous_Task_Control + -- No_Dependence => Ada.Calendar + -- No_Dependence => Ada.Task_Attributes + -- are already set by previous call to Set_Profile_Restrictions. + + -- Set the following restrictions which were added to Ada 2005: + -- No_Dependence => Ada.Execution_Time.Group_Budget + -- No_Dependence => Ada.Execution_Time.Timers + + if Ada_Version >= Ada_2005 then + Name_Buffer (1 .. 3) := "ada"; + Name_Len := 3; + + Prefix_Entity := Make_Identifier (Loc, Name_Find); + + Name_Buffer (1 .. 14) := "execution_time"; + Name_Len := 14; + + Selector_Entity := Make_Identifier (Loc, Name_Find); + + Prefix_Node := + Make_Selected_Component + (Sloc => Loc, + Prefix => Prefix_Entity, + Selector_Name => Selector_Entity); + + Name_Buffer (1 .. 13) := "group_budgets"; + Name_Len := 13; + + Selector_Entity := Make_Identifier (Loc, Name_Find); + + Node := + Make_Selected_Component + (Sloc => Loc, + Prefix => Prefix_Node, + Selector_Name => Selector_Entity); + + Set_Restriction_No_Dependence + (Unit => Node, + Warn => Treat_Restrictions_As_Warnings, + Profile => Ravenscar); + + Name_Buffer (1 .. 6) := "timers"; + Name_Len := 6; + + Selector_Entity := Make_Identifier (Loc, Name_Find); + + Node := + Make_Selected_Component + (Sloc => Loc, + Prefix => Prefix_Node, + Selector_Name => Selector_Entity); + + Set_Restriction_No_Dependence + (Unit => Node, + Warn => Treat_Restrictions_As_Warnings, + Profile => Ravenscar); + end if; + + -- Set the following restrictions which was added to Ada 2012 (see + -- AI-0171): + -- No_Dependence => System.Multiprocessors.Dispatching_Domains + + if Ada_Version >= Ada_2012 then + Name_Buffer (1 .. 6) := "system"; + Name_Len := 6; + + Prefix_Entity := Make_Identifier (Loc, Name_Find); + + Name_Buffer (1 .. 15) := "multiprocessors"; + Name_Len := 15; + + Selector_Entity := Make_Identifier (Loc, Name_Find); + + Prefix_Node := + Make_Selected_Component + (Sloc => Loc, + Prefix => Prefix_Entity, + Selector_Name => Selector_Entity); + + Name_Buffer (1 .. 19) := "dispatching_domains"; + Name_Len := 19; + + Selector_Entity := Make_Identifier (Loc, Name_Find); + + Node := + Make_Selected_Component + (Sloc => Loc, + Prefix => Prefix_Node, + Selector_Name => Selector_Entity); + + Set_Restriction_No_Dependence + (Unit => Node, + Warn => Treat_Restrictions_As_Warnings, + Profile => Ravenscar); + end if; end Set_Ravenscar_Profile; -- Start of processing for Analyze_Pragma diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index e82bd76da9c..aedfc0fe882 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -59,6 +59,7 @@ gcc -c ^ GNAT COMPILE -gnatDG ^ /XDEBUG /EXPAND_SOURCEA -gnatD ^ /XDEBUG -gnatec ^ /CONFIGURATION_PRAGMAS_FILE +-gnateE ^ /EXTRA_EXCEPTION_INFORMATION -gnateD ^ /SYMBOL_PREPROCESSING -gnatef ^ /FULL_PATH_IN_BRIEF_MESSAGES -gnateG ^ /GENERATE_PROCESSED_SOURCE diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index d222c52c12f..38863716770 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -261,7 +261,7 @@ package Uintp is -- or decimal format. Auto, the default setting, lets the routine make -- a decision based on the value. - UI_Image_Max : constant := 32; + UI_Image_Max : constant := 48; -- Enough for a 128-bit number UI_Image_Buffer : String (1 .. UI_Image_Max); UI_Image_Length : Natural; -- Buffer used for UI_Image as described below diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index 0f2f2749da0..1c95ee6117b 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -1323,48 +1323,8 @@ package body Urealp is if Val.Num = 0 then Write_Str ("0.0"); - -- Constants in base 10 can be written in normal Ada literal style - - elsif Val.Rbase = 10 then - - -- Use fixed-point format for small scaling values - - if Val.Den = 0 then - UI_Write (Val.Num, Decimal); - Write_Str (".0"); - - elsif Val.Den = 1 then - UI_Write (Val.Num / 10, Decimal); - Write_Char ('.'); - UI_Write (Val.Num mod 10, Decimal); - - elsif Val.Den = 2 then - UI_Write (Val.Num / 100, Decimal); - Write_Char ('.'); - UI_Write (Val.Num mod 100 / 10, Decimal); - UI_Write (Val.Num mod 10, Decimal); - - elsif Val.Den = -1 then - UI_Write (Val.Num, Decimal); - Write_Str ("0.0"); - - elsif Val.Den = -2 then - UI_Write (Val.Num, Decimal); - Write_Str ("00.0"); - - -- Else use exponential format - - else - UI_Write (Val.Num / 10, Decimal); - Write_Char ('.'); - UI_Write (Val.Num mod 10, Decimal); - Write_Char ('E'); - UI_Write (1 - Val.Den, Decimal); - end if; - - -- If we have a constant in a base other than 10, and the denominator - -- is zero, then the value is simply the numerator value, since we are - -- dividing by base**0, which is 1. + -- For constants with a denominator of zero, the value is simply the + -- numerator value, since we are dividing by base**0, which is 1. elsif Val.Den = 0 then UI_Write (Val.Num, Decimal); @@ -1411,6 +1371,96 @@ package body Urealp is Write_Str (".0"); end if; + -- Constants in base 2, 10 or 16 can be written in normal Ada literal + -- style, as long as they fit in the UI_Image_Buffer. Using hexadecimal + -- notation, 4 bytes are required for the 16# # part, and every fifth + -- character is an underscore. So, a buffer of size N has room for + + -- ((N - 4) - (N - 4) / 5) * 4 bits + + -- or at least + + -- N * 16 / 5 - 12 bits + + elsif (Val.Rbase = 10 or else Val.Rbase = 16) + and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12 + then + declare + Format : UI_Format := Decimal; + Scale : Uint; + + begin + if Val.Rbase = 16 then + Write_Str ("16#"); + Format := Hex; + end if; + + -- Use fixed-point format for small scaling values + + if Val.Den = 1 then + UI_Write (Val.Num / Val.Rbase, Format); + Write_Char ('.'); + UI_Write (Val.Num mod Val.Rbase, Format); + + elsif Val.Den = 2 then + UI_Write (Val.Num / Val.Rbase**Uint_2, Format); + Write_Char ('.'); + UI_Write (Val.Num mod Val.Rbase**Uint_2 / Val.Rbase, Format); + UI_Write (Val.Num mod Val.Rbase, Format); + + elsif Val.Den = -1 then + UI_Write (Val.Num, Format); + Write_Str ("0.0"); + + elsif Val.Den = -2 then + UI_Write (Val.Num, Format); + Write_Str ("00.0"); + + -- Else use exponential format + + else + UI_Image (Val.Num, Format); + Scale := UI_From_Int (Int (UI_Image_Length)); + + if Format = Decimal then + + -- Write decimal constants with a non-zero unit digit. This + -- matches usual scientific notation. + + Write_Char (UI_Image_Buffer (1)); + Write_Char ('.'); + + if UI_Image_Length = 1 then + Write_Char ('0'); + else + Write_Str (UI_Image_Buffer (2 .. UI_Image_Length)); + end if; + + Scale := Scale - 1; -- First digit is at unit position + else + pragma Assert (Format = Hex); + + -- Write hexadecimal constants with a zero unit digit. This + -- matches the Ada canonical form for binary floating point + -- numbers, and also ensures that the underscores end up in + -- the correct place. + + Write_Str ("0."); + Write_Str (UI_Image_Buffer (4 .. UI_Image_Length)); + Scale := Scale - 4; -- Subtract 16# # + Scale := Scale - Scale / 5; -- Subtract underscores; + end if; + + Write_Char ('E'); + Format := Decimal; + UI_Write (Scale - Val.Den, Decimal); + end if; + + if Format = Hex then + Write_Char ('#'); + end if; + end; + -- Constants in a base other than 10 can still be easily written -- in normal Ada literal style if the numerator is one. diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 03d8fbc18ec..8df60aae9f8 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -1543,6 +1543,15 @@ package VMS_Data is "-gnatm999999"; -- NODOC (see /ERROR_LIMIT) + S_GCC_Except : aliased constant S := "/EXTRA_EXCEPTION_INFORMATION " & + "-gnateE"; + -- /EXTRA_EXCEPTION_INFORMATION + -- + -- Generate extra information in exception messages, in particular + -- display extra column information and the value and range associated + -- with index and range check failures, and extra column information for + -- access checks. + S_GCC_Expand : aliased constant S := "/EXPAND_SOURCE " & "-gnatG"; -- /NOEXPAND_SOURCE (D) @@ -3522,6 +3531,7 @@ package VMS_Data is S_GCC_ErrorX 'Access, S_GCC_Expand 'Access, S_GCC_Lexpand 'Access, + S_GCC_Except 'Access, S_GCC_Extend 'Access, S_GCC_Ext 'Access, S_GCC_File 'Access, |