diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 29 | ||||
| -rw-r--r-- | gcc/ada/atree.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/gnat1drv.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/impunit.adb | 98 | ||||
| -rw-r--r-- | gcc/ada/impunit.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/sinfo.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 17 | ||||
| -rw-r--r-- | gcc/ada/sinput.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 5 |
12 files changed, 149 insertions, 64 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 52b839b..2931059 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2015-11-12 Ed Schonberg <schonberg@adacore.com> + + * sem_ch8.adb (Find_Selected_Component): In a synchronized + body, a reference to an operation of an object of the same + synchronized type was always interpreted as a reference to the + current instance. This is not always the case, as the prefix of + the reference may designate an object of the same type declared + in the enclosing context prior to the body. + +2015-11-12 Arnaud Charlet <charlet@adacore.com> + + * impunit.ads, impunit.adb (Get_Kind_Of_File): New. Cleaned up + implementation from previous Get_Kind_Of_Unit. + (Get_Kind_Of_Unit): Reimplemented using Get_Kind_Of_File. + * debug.adb: Remove d.4 switch, no longer used. + * opt.ads: Update doc on Debugger_Level. + * gnat1drv.adb: Code clean ups. + * sinput.ads: minor fix in comment + +2015-11-12 Bob Duff <duff@adacore.com> + + * sinfo.adb, sinfo.ads, sem_ch6.adb, atree.ads: Add + Was_Expression_Function flag, which is set in sem_ch6.adb when + converting an Expression_Function into a Subprogram_Body. + +2015-11-12 Pascal Obry <obry@adacore.com> + + * usage.adb: Update overflow checking documentation. + 2015-11-12 Tristan Gingold <gingold@adacore.com> * snames.ads-tmpl: Name_Gnat_Extended_Ravenscar: New identifier. diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 56763c7..08ea277 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -181,7 +181,7 @@ package Atree is -- Flag10 -- Flag11 Note that Flag0-3 are stored separately in the Flags -- Flag12 table, but that's a detail of the implementation which - -- Flag13 is entirely hidden by the funcitonal interface. + -- Flag13 is entirely hidden by the functional interface. -- Flag14 -- Flag15 -- Flag16 diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 586844d..e84719a 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -148,12 +148,16 @@ procedure Gnat1drv is Generate_C_Code := True; Modify_Tree_For_C := True; Unnest_Subprogram_Mode := True; - Back_Annotate_Rep_Info := True; -- Set operating mode to Generate_Code to benefit from full front-end -- expansion (e.g. generics). Operating_Mode := Generate_Code; + + -- Suppress alignment checks since we do not have access to alignment + -- info on the target + + Suppress_Options.Suppress (Alignment_Check) := False; end if; -- -gnatd.E sets Error_To_Warning mode, causing selected error messages @@ -1346,8 +1350,8 @@ begin Back_End.Call_Back_End (Back_End_Mode); -- Once the backend is complete, we unlock the names table. This call - -- allows a few extra entries, needed for example for the file name for - -- the library file output. + -- allows a few extra entries, needed for example for the file name + -- for the library file output. Namet.Unlock; diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 6f6c9ba..5fea99d 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -635,23 +635,22 @@ package body Impunit is ("utf_32", Sutf_32'Access)); ---------------------- - -- Get_Kind_Of_Unit -- + -- Get_Kind_Of_File -- ---------------------- - function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is - Fname : constant File_Name_Type := Unit_File_Name (U); + function Get_Kind_Of_File (File : String) return Kind_Of_Unit is + pragma Assert (File'First = 1); + + Buffer : String (1 .. 8); begin Error_Msg_Strlen := 0; - Get_Name_String (Fname); -- Ada/System/Interfaces are all Ada 95 units - if (Name_Len = 7 and then Name_Buffer (1 .. 7) = "ada.ads") - or else - (Name_Len = 10 and then Name_Buffer (1 .. 10) = "system.ads") - or else - (Name_Len = 12 and then Name_Buffer (1 .. 12) = "interfac.ads") + if File = "ada.ads" + or else File = "system.ads" + or else File = "interfac.ads" then return Ada_95_Unit; end if; @@ -659,21 +658,19 @@ package body Impunit is -- If length of file name is greater than 12, not predefined. The value -- 12 here is an 8 char name with extension .ads. - if Name_Len > 12 then + if File'Length > 12 then return Not_Predefined_Unit; end if; -- Not predefined if file name does not start with a- g- s- i- - if Name_Len < 3 - or else Name_Buffer (2) /= '-' - or else (Name_Buffer (1) /= 'a' - and then - Name_Buffer (1) /= 'g' - and then - Name_Buffer (1) /= 'i' - and then - Name_Buffer (1) /= 's') + if File'Length < 3 + or else File (2) /= '-' + or else + (File (1) /= 'a' + and then File (1) /= 'g' + and then File (1) /= 'i' + and then File (1) /= 's') then return Not_Predefined_Unit; end if; @@ -687,25 +684,25 @@ package body Impunit is -- this routine to detect when a construct comes from an instance of -- a generic defined in a predefined unit. - if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" + if File (File'Last - 3 .. File'Last) /= ".ads" and then - Name_Buffer (Name_Len - 3 .. Name_Len) /= ".adb" + File (File'Last - 3 .. File'Last) /= ".adb" then return Not_Predefined_Unit; end if; -- Otherwise normalize file name to 8 characters - Name_Len := Name_Len - 4; - while Name_Len < 8 loop - Name_Len := Name_Len + 1; - Name_Buffer (Name_Len) := ' '; + Buffer (1 .. File'Length - 4) := File (1 .. File'Length - 4); + + for J in File'Length - 3 .. 8 loop + Buffer (J) := ' '; end loop; -- See if name is in 95 list for J in Non_Imp_File_Names_95'Range loop - if Name_Buffer (1 .. 8) = Non_Imp_File_Names_95 (J).Fname then + if Buffer = Non_Imp_File_Names_95 (J).Fname then return Ada_95_Unit; end if; end loop; @@ -713,7 +710,7 @@ package body Impunit is -- See if name is in 2005 list for J in Non_Imp_File_Names_05'Range loop - if Name_Buffer (1 .. 8) = Non_Imp_File_Names_05 (J).Fname then + if Buffer = Non_Imp_File_Names_05 (J).Fname then return Ada_2005_Unit; end if; end loop; @@ -721,7 +718,7 @@ package body Impunit is -- See if name is in 2012 list for J in Non_Imp_File_Names_12'Range loop - if Name_Buffer (1 .. 8) = Non_Imp_File_Names_12 (J).Fname then + if Buffer = Non_Imp_File_Names_12 (J).Fname then return Ada_2012_Unit; end if; end loop; @@ -729,22 +726,9 @@ package body Impunit is -- Only remaining special possibilities are children of System.RPC and -- System.Garlic and special files of the form System.Aux... - Get_Name_String (Unit_Name (U)); - - if Name_Len > 12 - and then Name_Buffer (1 .. 11) = "system.rpc." - then - return Ada_95_Unit; - end if; - - if Name_Len > 15 - and then Name_Buffer (1 .. 14) = "system.garlic." - then - return Ada_95_Unit; - end if; - - if Name_Len > 11 - and then Name_Buffer (1 .. 10) = "system.aux" + if File (1 .. 5) = "s-rpc" + or else File (1 .. 5) = "s-gar" + or else File (1 .. 5) = "s-aux" then return Ada_95_Unit; end if; @@ -752,18 +736,16 @@ package body Impunit is -- All tests failed, this is definitely an implementation unit. See if -- we have an alternative name. - Get_Name_String (Fname); - - if Name_Len in 11 .. 12 - and then Name_Buffer (1 .. 2) = "s-" - and then Name_Buffer (Name_Len - 3 .. Name_Len) = ".ads" + if File'Length in 11 .. 12 + and then File (1 .. 2) = "s-" + and then File (File'Last - 3 .. File'Last) = ".ads" then for J in Map_Array'Range loop - if (Name_Len = 12 and then - Name_Buffer (3 .. 8) = Map_Array (J).Fname) + if (File'Length = 12 and then + File (3 .. 8) = Map_Array (J).Fname) or else - (Name_Len = 11 and then - Name_Buffer (3 .. 7) = Map_Array (J).Fname (1 .. 5)) + (File'Length = 11 and then + File (3 .. 7) = Map_Array (J).Fname (1 .. 5)) then Error_Msg_Strlen := Map_Array (J).Aname'Length; Error_Msg_String (1 .. Error_Msg_Strlen) := @@ -773,6 +755,16 @@ package body Impunit is end if; return Implementation_Unit; + end Get_Kind_Of_File; + + ---------------------- + -- Get_Kind_Of_Unit -- + ---------------------- + + function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit is + begin + Get_Name_String (Unit_File_Name (U)); + return Get_Kind_Of_File (Name_Buffer (1 .. Name_Len)); end Get_Kind_Of_Unit; ------------------- diff --git a/gcc/ada/impunit.ads b/gcc/ada/impunit.ads index be3e8d3..f4a1157 100644 --- a/gcc/ada/impunit.ads +++ b/gcc/ada/impunit.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -62,11 +62,14 @@ package Impunit is function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit; -- Given the unit number of a unit, this function determines the type -- of the unit, as defined above. If the result is Implementation_Unit, - -- then the name of a possible atlernative equivalent unit is placed in + -- then the name of a possible alternative equivalent unit is placed in -- Error_Msg_String/Slen on return. If there is no alternative name, or if -- the result is not Implementation_Unit, then Error_Msg_Slen is zero on -- return, indicating that no alternative name was found. + function Get_Kind_Of_File (File : String) return Kind_Of_Unit; + -- Same as Get_Kind_Of_Unit, for a given filename + function Is_Known_Unit (Nam : Node_Id) return Boolean; -- Nam is the possible name of a child unit, represented as a selected -- component node. This function determines whether the name matches one of diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index e99c6b7..60aeb28 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -422,8 +422,9 @@ package Opt is subtype Debug_Level_Value is Nat range 0 .. 3; Debugger_Level : Debug_Level_Value := 0; -- The value given to the -g parameter. The default value for -g with - -- no value is 2. This is not currently used but is retained for possible - -- future use. + -- no value is 2. If no -g is specified, defaults to 0. + -- Note that the generated code should never depend on this variable, + -- since we want debug info to be non intrusive on the generate code. Default_Exit_Status : Int := 0; -- GNATBIND diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 91e41e2..a40baa5 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -334,6 +334,7 @@ package body Sem_Ch6 is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (LocX, Statements => New_List (Ret))); + Set_Was_Expression_Function (New_Body); -- If the expression completes a generic subprogram, we must create a -- separate node for the body, because at instantiation the original diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index d448712..9e581e0 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -6774,7 +6774,26 @@ package body Sem_Ch8 is -- Prefix denotes an enclosing loop, block, or task, i.e. an -- enclosing construct that is not a subprogram or accept. - Find_Expanded_Name (N); + -- A special case: a protected body may call an operation + -- on an external object of the same type, in which case it + -- is not an expanded name. If the prefix is the type itself, + -- or the context is a single synchronized object it can only + -- be interpreted as an expanded name. + + if Is_Concurrent_Type (Etype (P_Name)) then + if Is_Type (P_Name) + or else Present (Anonymous_Object (Etype (P_Name))) + then + Find_Expanded_Name (N); + + else + Analyze_Selected_Component (N); + return; + end if; + + else + Find_Expanded_Name (N); + end if; elsif Ekind (P_Name) = E_Package then Find_Expanded_Name (N); diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 5f57e8c..b97fa58 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -3286,6 +3286,14 @@ package body Sinfo is return Elist5 (N); end Used_Operations; + function Was_Expression_Function + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Body); + return Flag18 (N); + end Was_Expression_Function; + function Was_Originally_Stub (N : Node_Id) return Boolean is begin @@ -6525,6 +6533,14 @@ package body Sinfo is Set_Elist5 (N, Val); end Set_Used_Operations; + procedure Set_Was_Expression_Function + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Subprogram_Body); + Set_Flag18 (N, Val); + end Set_Was_Expression_Function; + procedure Set_Was_Originally_Stub (N : Node_Id; Val : Boolean := True) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index ab76d2c..4b18de9 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -2220,6 +2220,14 @@ package Sinfo is -- on exit from the scope of the use_type_clause, in particular in the -- case of Use_All_Type, when those operations several scopes. + -- Was_Expression_Function (Flag18-Sem) + -- Present in N_Subprogram_Body. True if the original source had an + -- N_Expression_Function, which was converted to the N_Subprogram_Body + -- by Analyze_Expression_Function. This is needed by ASIS to correctly + -- recreate the expression function (for the instance body) when the + -- completion of a generic function declaration is an expression + -- function. + -- Was_Originally_Stub (Flag13-Sem) -- This flag is set in the node for a proper body that replaces stub. -- During the analysis procedure, stubs in some situations get rewritten @@ -5212,6 +5220,7 @@ package Sinfo is -- Is_Task_Master (Flag5-Sem) -- Was_Originally_Stub (Flag13-Sem) -- Has_Relative_Deadline_Pragma (Flag9-Sem) + -- Was_Expression_Function (Flag18-Sem) ------------------------- -- Expression Function -- @@ -9795,6 +9804,9 @@ package Sinfo is function Used_Operations (N : Node_Id) return Elist_Id; -- Elist5 + function Was_Expression_Function + (N : Node_Id) return Boolean; -- Flag18 + function Was_Originally_Stub (N : Node_Id) return Boolean; -- Flag13 @@ -10830,6 +10842,9 @@ package Sinfo is procedure Set_Used_Operations (N : Node_Id; Val : Elist_Id); -- Elist5 + procedure Set_Was_Expression_Function + (N : Node_Id; Val : Boolean := True); -- Flag18 + procedure Set_Was_Originally_Stub (N : Node_Id; Val : Boolean := True); -- Flag13 @@ -12938,6 +12953,7 @@ package Sinfo is pragma Inline (Variants); pragma Inline (Visible_Declarations); pragma Inline (Used_Operations); + pragma Inline (Was_Expression_Function); pragma Inline (Was_Originally_Stub); pragma Inline (Withed_Body); @@ -13277,6 +13293,7 @@ package Sinfo is pragma Inline (Set_Variant_Part); pragma Inline (Set_Variants); pragma Inline (Set_Visible_Declarations); + pragma Inline (Set_Was_Expression_Function); pragma Inline (Set_Was_Originally_Stub); pragma Inline (Set_Withed_Body); diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 76ff651..f1a2724 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -608,7 +608,7 @@ package Sinput is function Num_Source_Lines (S : Source_File_Index) return Nat; -- Returns the number of source lines (this is equivalent to reading -- the value of Last_Source_Line, but returns Nat rather than a - -- physical line number. + -- physical line number). procedure Register_Source_Ref_Pragma (File_Name : File_Name_Type; diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index ae0981f..99edf94 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -360,8 +360,11 @@ begin -- Line for -gnato switch + Write_Switch_Char ("o0"); + Write_Line ("Disable overflow checking (on by default)"); + Write_Switch_Char ("o"); - Write_Line ("Enable overflow checking mode to CHECKED (off by default)"); + Write_Line ("Enable overflow checking in STRICT (-gnato1) mode (default)"); -- Lines for -gnato? switches |