[multiple changes]
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. From-SVN: r230243
This commit is contained in:
Arnaud Charlet
parent
b3083540f5
commit
549cc9c2bc
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
-------------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue