+2015-10-23 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_dim.adb (Analyze_Dimension_Extension_Or_Record_Aggregate):
+ Handle properly a box-initialized aggregate component.
+
+2015-10-23 Yannick Moy <moy@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma): Reject Volatile_Function not placed
+ on a function.
+
+2015-10-23 Yannick Moy <moy@adacore.com>
+
+ * a-extiin.ads, a-reatim.ads, a-interr.ads, a-exetim-mingw.ads,
+ a-exetim-default.ads, a-exetim.ads, a-taside.ads: Add "Global => null"
+ contract on subprograms.
+ * lib-xref-spark_specific.adb: collect scopes for stubs of
+ protected objects
+
+2015-10-23 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): Enable
+ Back_Annotate_Rep_Info to get size information from gigi.
+ (Gnat1drv): Code clean ups.
+ * frontend.adb (Frontend): Ditto.
+
2015-10-23 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb (Adjust_Global_Switches): Adjust settings.
function "+"
(Left : CPU_Time;
- Right : Ada.Real_Time.Time_Span) return CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ with
+ Global => null;
function "+"
(Left : Ada.Real_Time.Time_Span;
- Right : CPU_Time) return CPU_Time;
+ Right : CPU_Time) return CPU_Time
+ with
+ Global => null;
function "-"
(Left : CPU_Time;
- Right : Ada.Real_Time.Time_Span) return CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ with
+ Global => null;
function "-"
(Left : CPU_Time;
- Right : CPU_Time) return Ada.Real_Time.Time_Span;
+ Right : CPU_Time) return Ada.Real_Time.Time_Span
+ with
+ Global => null;
- function "<" (Left, Right : CPU_Time) return Boolean;
- function "<=" (Left, Right : CPU_Time) return Boolean;
- function ">" (Left, Right : CPU_Time) return Boolean;
- function ">=" (Left, Right : CPU_Time) return Boolean;
+ function "<" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function "<=" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function ">" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function ">=" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
procedure Split
(T : CPU_Time;
SC : out Ada.Real_Time.Seconds_Count;
- TS : out Ada.Real_Time.Time_Span);
+ TS : out Ada.Real_Time.Time_Span)
+ with
+ Global => null;
function Time_Of
(SC : Ada.Real_Time.Seconds_Count;
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
- return CPU_Time;
+ return CPU_Time
+ with
+ Global => null;
Interrupt_Clocks_Supported : constant Boolean := False;
Separate_Interrupt_Clocks_Supported : constant Boolean := False;
function "+"
(Left : CPU_Time;
- Right : Ada.Real_Time.Time_Span) return CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ with
+ Global => null;
function "+"
(Left : Ada.Real_Time.Time_Span;
- Right : CPU_Time) return CPU_Time;
+ Right : CPU_Time) return CPU_Time
+ with
+ Global => null;
function "-"
(Left : CPU_Time;
- Right : Ada.Real_Time.Time_Span) return CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ with
+ Global => null;
function "-"
(Left : CPU_Time;
Right : CPU_Time) return Ada.Real_Time.Time_Span;
- function "<" (Left, Right : CPU_Time) return Boolean;
- function "<=" (Left, Right : CPU_Time) return Boolean;
- function ">" (Left, Right : CPU_Time) return Boolean;
- function ">=" (Left, Right : CPU_Time) return Boolean;
+ function "<" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function "<=" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function ">" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function ">=" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
procedure Split
(T : CPU_Time;
SC : out Ada.Real_Time.Seconds_Count;
- TS : out Ada.Real_Time.Time_Span);
+ TS : out Ada.Real_Time.Time_Span)
+ with
+ Global => null;
function Time_Of
(SC : Ada.Real_Time.Seconds_Count;
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
- return CPU_Time;
+ return CPU_Time
+ with
+ Global => null;
Interrupt_Clocks_Supported : constant Boolean := False;
Separate_Interrupt_Clocks_Supported : constant Boolean := False;
function "+"
(Left : CPU_Time;
- Right : Ada.Real_Time.Time_Span) return CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ with
+ Global => null;
function "+"
(Left : Ada.Real_Time.Time_Span;
- Right : CPU_Time) return CPU_Time;
+ Right : CPU_Time) return CPU_Time
+ with
+ Global => null;
function "-"
(Left : CPU_Time;
- Right : Ada.Real_Time.Time_Span) return CPU_Time;
+ Right : Ada.Real_Time.Time_Span) return CPU_Time
+ with
+ Global => null;
function "-"
(Left : CPU_Time;
- Right : CPU_Time) return Ada.Real_Time.Time_Span;
+ Right : CPU_Time) return Ada.Real_Time.Time_Span
+ with
+ Global => null;
- function "<" (Left, Right : CPU_Time) return Boolean;
- function "<=" (Left, Right : CPU_Time) return Boolean;
- function ">" (Left, Right : CPU_Time) return Boolean;
- function ">=" (Left, Right : CPU_Time) return Boolean;
+ function "<" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function "<=" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function ">" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
+ function ">=" (Left, Right : CPU_Time) return Boolean with
+ Global => null;
procedure Split
(T : CPU_Time;
SC : out Ada.Real_Time.Seconds_Count;
- TS : out Ada.Real_Time.Time_Span);
+ TS : out Ada.Real_Time.Time_Span)
+ with
+ Global => null;
function Time_Of
(SC : Ada.Real_Time.Seconds_Count;
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
- return CPU_Time;
+ return CPU_Time
+ with
+ Global => null;
Interrupt_Clocks_Supported : constant Boolean := False;
Separate_Interrupt_Clocks_Supported : constant Boolean := False;
Volatile_Function,
Global => Ada.Real_Time.Clock_Time;
- function Supported (Interrupt : Ada.Interrupts.Interrupt_ID) return Boolean;
+ function Supported (Interrupt : Ada.Interrupts.Interrupt_ID) return Boolean
+ with
+ Global => null;
end Ada.Execution_Time.Interrupts;
function Current_Handler
(Interrupt : Interrupt_ID) return Parameterless_Handler
with
- SPARK_Mode => Off;
+ SPARK_Mode => Off,
+ Global => null;
procedure Attach_Handler
(New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID)
with
- SPARK_Mode => Off;
+ SPARK_Mode => Off,
+ Global => null;
procedure Exchange_Handler
(Old_Handler : out Parameterless_Handler;
New_Handler : Parameterless_Handler;
Interrupt : Interrupt_ID)
with
- SPARK_Mode => Off;
+ SPARK_Mode => Off,
+ Global => null;
procedure Detach_Handler (Interrupt : Interrupt_ID) with
SPARK_Mode,
Global => (In_Out => Ada.Task_Identification.Tasking_State);
function Reference (Interrupt : Interrupt_ID) return System.Address with
- SPARK_Mode => Off;
+ SPARK_Mode => Off,
+ Global => null;
private
pragma Inline (Is_Reserved);
Volatile_Function,
Global => Clock_Time;
- function "+" (Left : Time; Right : Time_Span) return Time;
- function "+" (Left : Time_Span; Right : Time) return Time;
- function "-" (Left : Time; Right : Time_Span) return Time;
- function "-" (Left : Time; Right : Time) return Time_Span;
-
- function "<" (Left, Right : Time) return Boolean;
- function "<=" (Left, Right : Time) return Boolean;
- function ">" (Left, Right : Time) return Boolean;
- function ">=" (Left, Right : Time) return Boolean;
-
- function "+" (Left, Right : Time_Span) return Time_Span;
- function "-" (Left, Right : Time_Span) return Time_Span;
- function "-" (Right : Time_Span) return Time_Span;
- function "*" (Left : Time_Span; Right : Integer) return Time_Span;
- function "*" (Left : Integer; Right : Time_Span) return Time_Span;
- function "/" (Left, Right : Time_Span) return Integer;
- function "/" (Left : Time_Span; Right : Integer) return Time_Span;
-
- function "abs" (Right : Time_Span) return Time_Span;
-
- function "<" (Left, Right : Time_Span) return Boolean;
- function "<=" (Left, Right : Time_Span) return Boolean;
- function ">" (Left, Right : Time_Span) return Boolean;
- function ">=" (Left, Right : Time_Span) return Boolean;
-
- function To_Duration (TS : Time_Span) return Duration;
- function To_Time_Span (D : Duration) return Time_Span;
-
- function Nanoseconds (NS : Integer) return Time_Span;
- function Microseconds (US : Integer) return Time_Span;
- function Milliseconds (MS : Integer) return Time_Span;
-
- function Seconds (S : Integer) return Time_Span;
+ function "+" (Left : Time; Right : Time_Span) return Time with
+ Global => null;
+ function "+" (Left : Time_Span; Right : Time) return Time with
+ Global => null;
+ function "-" (Left : Time; Right : Time_Span) return Time with
+ Global => null;
+ function "-" (Left : Time; Right : Time) return Time_Span with
+ Global => null;
+
+ function "<" (Left, Right : Time) return Boolean with
+ Global => null;
+ function "<=" (Left, Right : Time) return Boolean with
+ Global => null;
+ function ">" (Left, Right : Time) return Boolean with
+ Global => null;
+ function ">=" (Left, Right : Time) return Boolean with
+ Global => null;
+
+ function "+" (Left, Right : Time_Span) return Time_Span with
+ Global => null;
+ function "-" (Left, Right : Time_Span) return Time_Span with
+ Global => null;
+ function "-" (Right : Time_Span) return Time_Span with
+ Global => null;
+ function "*" (Left : Time_Span; Right : Integer) return Time_Span with
+ Global => null;
+ function "*" (Left : Integer; Right : Time_Span) return Time_Span with
+ Global => null;
+ function "/" (Left, Right : Time_Span) return Integer with
+ Global => null;
+ function "/" (Left : Time_Span; Right : Integer) return Time_Span with
+ Global => null;
+
+ function "abs" (Right : Time_Span) return Time_Span with
+ Global => null;
+
+ function "<" (Left, Right : Time_Span) return Boolean with
+ Global => null;
+ function "<=" (Left, Right : Time_Span) return Boolean with
+ Global => null;
+ function ">" (Left, Right : Time_Span) return Boolean with
+ Global => null;
+ function ">=" (Left, Right : Time_Span) return Boolean with
+ Global => null;
+
+ function To_Duration (TS : Time_Span) return Duration with
+ Global => null;
+ function To_Time_Span (D : Duration) return Time_Span with
+ Global => null;
+
+ function Nanoseconds (NS : Integer) return Time_Span with
+ Global => null;
+ function Microseconds (US : Integer) return Time_Span with
+ Global => null;
+ function Milliseconds (MS : Integer) return Time_Span with
+ Global => null;
+
+ function Seconds (S : Integer) return Time_Span with
+ Global => null;
pragma Ada_05 (Seconds);
- function Minutes (M : Integer) return Time_Span;
+ function Minutes (M : Integer) return Time_Span with
+ Global => null;
pragma Ada_05 (Minutes);
type Seconds_Count is new Long_Long_Integer;
-- in the case of CodePeer with a target configuration file with a maximum
-- integer size of 32, it allows analysis of this unit.
- procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span);
- function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time;
+ procedure Split (T : Time; SC : out Seconds_Count; TS : out Time_Span)
+ with
+ Global => null;
+ function Time_Of (SC : Seconds_Count; TS : Time_Span) return Time
+ with
+ Global => null;
private
pragma SPARK_Mode (Off);
Null_Task_Id : constant Task_Id;
- function "=" (Left, Right : Task_Id) return Boolean;
+ function "=" (Left, Right : Task_Id) return Boolean with
+ Global => null;
pragma Inline ("=");
- function Image (T : Task_Id) return String;
+ function Image (T : Task_Id) return String with
+ Global => null;
function Current_Task return Task_Id with
Volatile_Function,
pragma Inline (Current_Task);
function Environment_Task return Task_Id with
- SPARK_Mode => Off;
+ SPARK_Mode => Off,
+ Global => null;
pragma Inline (Environment_Task);
- procedure Abort_Task (T : Task_Id);
+ procedure Abort_Task (T : Task_Id) with
+ Global => null;
pragma Inline (Abort_Task);
-- Note: parameter is mode IN, not IN OUT, per AI-00101
with Back_End; use Back_End;
with Checks;
with Comperr;
+with Cprint;
with Csets; use Csets;
with Debug; use Debug;
with Elists;
Generate_C_Code := True;
Modify_Tree_For_C := True;
Unnest_Subprogram_Mode := True;
+ Back_Annotate_Rep_Info := True;
-- Enable some restrictions systematically to simplify the generated
-- code. Note that restriction checks are also disabled in C mode,
Namet.Unlock;
+ -- Finally generate C source code if needed. Note that this needs to
+ -- happen after calling gigi to take advantage of the back annotation.
+
+ if Generate_C_Code then
+ Cprint.Source_Dump;
+ end if;
+
-- Generate the call-graph output of dispatching calls
Exp_CG.Generate_CG_Output;
(N : Node_Id;
Process : Node_Processing;
Inside_Stubs : Boolean);
+ procedure Traverse_Protected_Body
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean);
procedure Traverse_Package_Body
(N : Node_Id;
Process : Node_Processing;
elsif Nkind (Lu) = N_Package_Body then
Traverse_Package_Body (Lu, Process, Inside_Stubs);
+ elsif Nkind (Lu) = N_Protected_Body then
+ Traverse_Protected_Body (Lu, Process, Inside_Stubs);
+
-- All other cases of compilation units (e.g. renamings), are not
-- declarations, or else generic declarations which are ignored.
(Private_Declarations (N), Process, Inside_Stubs);
when N_Protected_Body =>
- Traverse_Declarations_Or_Statements
- (Declarations (N), Process, Inside_Stubs);
+ Traverse_Protected_Body (N, Process, Inside_Stubs);
when N_Protected_Body_Stub =>
if Present (Library_Unit (N)) then
(Private_Declarations (Spec), Process, Inside_Stubs);
end Traverse_Package_Declaration;
+ -----------------------------
+ -- Traverse_Protected_Body --
+ -----------------------------
+
+ procedure Traverse_Protected_Body
+ (N : Node_Id;
+ Process : Node_Processing;
+ Inside_Stubs : Boolean) is
+ begin
+ Traverse_Declarations_Or_Statements
+ (Declarations (N), Process, Inside_Stubs);
+ end Traverse_Protected_Body;
+
------------------------------
-- Traverse_Subprogram_Body --
------------------------------
if Has_Dimension_System (Base_Type (Comp_Typ)) then
Expr := Expression (Comp);
+ -- A box-initialized component needs no checking.
+
+ if No (Expr) and then Box_Present (Comp) then
+ null;
+
-- Issue an error if the dimensions of the component type and the
-- dimensions of the component mismatch.
- if Dimensions_Of (Expr) /= Dimensions_Of (Comp_Typ) then
+ elsif Dimensions_Of (Expr) /= Dimensions_Of (Comp_Typ) then
-- Check if an error has already been encountered so far
Spec_Id := Corresponding_Spec_Of (Subp_Decl);
Over_Id := Overridden_Operation (Spec_Id);
+ if not Ekind_In (Spec_Id, E_Function, E_Generic_Function) then
+ Pragma_Misplaced;
+ return;
+ end if;
+
-- A pragma that applies to a Ghost entity becomes Ghost for the
-- purposes of legality checks and removal of ignored Ghost code.
projects / gcc.git / commitdiff