mirror of git://gcc.gnu.org/git/gcc.git
[multiple changes]
2010-10-12 Robert Dewar <dewar@adacore.com> * exp_ch9.adb (Has_Pragma_Priority): New name for Has_Priority_Pragma * gnat_rm.texi (pragma Suppress_All): Document new placement rules * par-prag.adb (P_Pragma, case Suppress_All): Set Has_Pragma_Suppress_All flag. * sem_prag.adb (Has_Pragma_Priority): New name for Has_Priority_Pragma (Analyze_Pragma, case Suppress_All): Remove placement check (Process_Compilation_Unit_Pragmas): Use Has_Pragma_Suppress_All flag * sem_prag.ads (Process_Compilation_Unit_Pragmas): Update documentation * sinfo.adb (Has_Pragma_Suppress_All): New flag (Has_Pragma_Priority): New name for Has_Priority_Pragma * sinfo.ads (Has_Pragma_Suppress_All): New flag (Has_Pragma_Priority): New name for Has_Priority_Pragma 2010-10-12 Arnaud Charlet <charlet@adacore.com> * lib-xref.ads: Mark j/J as reserved for C++ classes. 2010-10-12 Jose Ruiz <ruiz@adacore.com> * a-exetim-default.ads, a-exetim-posix.adb: New. * gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for linux): Use the POSIX Realtime support to implement CPU clocks. (EXTRA_GNATRTL_TASKING_OBJS for linux): Add the a-exetim.o object to the tasking library. (THREADSLIB): Make the POSIX.1b Realtime Extensions library (librt) available for shared libraries. * gcc-interface/Make-lang.in: Update dependencies. 2010-10-12 Robert Dewar <dewar@adacore.com> * sem_ch13.adb (Analyze_Aspect_Specifications): For Pre/Post, break apart expressions with AND THEN clauses into separate pragmas. * sinput.ads, sinput.adab (Get_Logical_Line_Number_Img): New function. From-SVN: r165356
This commit is contained in:
Arnaud Charlet
parent
811ef5ba91
commit
c775c2094b
|
|
@ -1,3 +1,39 @@
|
|||
2010-10-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_ch9.adb (Has_Pragma_Priority): New name for Has_Priority_Pragma
|
||||
* gnat_rm.texi (pragma Suppress_All): Document new placement rules
|
||||
* par-prag.adb (P_Pragma, case Suppress_All): Set
|
||||
Has_Pragma_Suppress_All flag.
|
||||
* sem_prag.adb (Has_Pragma_Priority): New name for Has_Priority_Pragma
|
||||
(Analyze_Pragma, case Suppress_All): Remove placement check
|
||||
(Process_Compilation_Unit_Pragmas): Use Has_Pragma_Suppress_All flag
|
||||
* sem_prag.ads (Process_Compilation_Unit_Pragmas): Update documentation
|
||||
* sinfo.adb (Has_Pragma_Suppress_All): New flag
|
||||
(Has_Pragma_Priority): New name for Has_Priority_Pragma
|
||||
* sinfo.ads (Has_Pragma_Suppress_All): New flag
|
||||
(Has_Pragma_Priority): New name for Has_Priority_Pragma
|
||||
|
||||
2010-10-12 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* lib-xref.ads: Mark j/J as reserved for C++ classes.
|
||||
|
||||
2010-10-12 Jose Ruiz <ruiz@adacore.com>
|
||||
|
||||
* a-exetim-default.ads, a-exetim-posix.adb: New.
|
||||
* gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for linux): Use the
|
||||
POSIX Realtime support to implement CPU clocks.
|
||||
(EXTRA_GNATRTL_TASKING_OBJS for linux): Add the a-exetim.o object
|
||||
to the tasking library.
|
||||
(THREADSLIB): Make the POSIX.1b Realtime Extensions library (librt)
|
||||
available for shared libraries.
|
||||
* gcc-interface/Make-lang.in: Update dependencies.
|
||||
|
||||
2010-10-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): For Pre/Post, break
|
||||
apart expressions with AND THEN clauses into separate pragmas.
|
||||
* sinput.ads, sinput.adab (Get_Logical_Line_Number_Img): New function.
|
||||
|
||||
2010-10-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* par-ch13.adb (P_Aspect_Specifications): Fix handling of 'Class aspects
|
||||
|
|
|
|||
|
|
@ -0,0 +1,98 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- A D A . E X E C U T I O N _ T I M E --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2007-2010, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- This specification is derived from the Ada Reference Manual for use with --
|
||||
-- GNAT. The copyright notice above, and the license provisions that follow --
|
||||
-- apply solely to the contents of the part following the private keyword. --
|
||||
-- --
|
||||
-- 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- --
|
||||
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Task_Identification;
|
||||
with Ada.Real_Time;
|
||||
|
||||
package Ada.Execution_Time is
|
||||
|
||||
type CPU_Time is private;
|
||||
|
||||
CPU_Time_First : constant CPU_Time;
|
||||
CPU_Time_Last : constant CPU_Time;
|
||||
CPU_Time_Unit : constant := Ada.Real_Time.Time_Unit;
|
||||
CPU_Tick : constant Ada.Real_Time.Time_Span;
|
||||
|
||||
function Clock
|
||||
(T : Ada.Task_Identification.Task_Id
|
||||
:= Ada.Task_Identification.Current_Task)
|
||||
return CPU_Time;
|
||||
|
||||
function "+"
|
||||
(Left : CPU_Time;
|
||||
Right : Ada.Real_Time.Time_Span) return CPU_Time;
|
||||
|
||||
function "+"
|
||||
(Left : Ada.Real_Time.Time_Span;
|
||||
Right : CPU_Time) return CPU_Time;
|
||||
|
||||
function "-"
|
||||
(Left : CPU_Time;
|
||||
Right : Ada.Real_Time.Time_Span) return CPU_Time;
|
||||
|
||||
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;
|
||||
|
||||
procedure Split
|
||||
(T : CPU_Time;
|
||||
SC : out Ada.Real_Time.Seconds_Count;
|
||||
TS : out Ada.Real_Time.Time_Span);
|
||||
|
||||
function Time_Of
|
||||
(SC : Ada.Real_Time.Seconds_Count;
|
||||
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
|
||||
return CPU_Time;
|
||||
|
||||
private
|
||||
|
||||
type CPU_Time is new Ada.Real_Time.Time;
|
||||
|
||||
CPU_Time_First : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_First);
|
||||
CPU_Time_Last : constant CPU_Time := CPU_Time (Ada.Real_Time.Time_Last);
|
||||
|
||||
CPU_Tick : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Tick;
|
||||
|
||||
pragma Import (Intrinsic, "<");
|
||||
pragma Import (Intrinsic, "<=");
|
||||
pragma Import (Intrinsic, ">");
|
||||
pragma Import (Intrinsic, ">=");
|
||||
|
||||
end Ada.Execution_Time;
|
||||
|
|
@ -0,0 +1,157 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- GNAT RUN-TIME COMPONENTS --
|
||||
-- --
|
||||
-- A D A . E X E C U T I O N _ T I M E --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2007-2010, 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- --
|
||||
-- ware Foundation; either version 3, or (at your option) any later ver- --
|
||||
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
||||
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
||||
-- or FITNESS FOR A PARTICULAR PURPOSE. --
|
||||
-- --
|
||||
-- As a special exception under Section 7 of GPL version 3, you are granted --
|
||||
-- additional permissions described in the GCC Runtime Library Exception, --
|
||||
-- version 3.1, as published by the Free Software Foundation. --
|
||||
-- --
|
||||
-- You should have received a copy of the GNU General Public License and --
|
||||
-- a copy of the GCC Runtime Library Exception along with this program; --
|
||||
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
||||
-- <http://www.gnu.org/licenses/>. --
|
||||
-- --
|
||||
-- GNAT was originally developed by the GNAT team at New York University. --
|
||||
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
||||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This is the POSIX (Realtime Extension) version of this package
|
||||
|
||||
with Ada.Task_Identification; use Ada.Task_Identification;
|
||||
with Ada.Unchecked_Conversion;
|
||||
|
||||
with System.OS_Interface; use System.OS_Interface;
|
||||
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
|
||||
package body Ada.Execution_Time is
|
||||
|
||||
pragma Linker_Options ("-lrt");
|
||||
-- POSIX.1b Realtime Extensions library. Needed to have access to function
|
||||
-- clock_gettime.
|
||||
|
||||
---------
|
||||
-- "+" --
|
||||
---------
|
||||
|
||||
function "+"
|
||||
(Left : CPU_Time;
|
||||
Right : Ada.Real_Time.Time_Span) return CPU_Time
|
||||
is
|
||||
use type Ada.Real_Time.Time;
|
||||
begin
|
||||
return CPU_Time (Ada.Real_Time.Time (Left) + Right);
|
||||
end "+";
|
||||
|
||||
function "+"
|
||||
(Left : Ada.Real_Time.Time_Span;
|
||||
Right : CPU_Time) return CPU_Time
|
||||
is
|
||||
use type Ada.Real_Time.Time;
|
||||
begin
|
||||
return CPU_Time (Left + Ada.Real_Time.Time (Right));
|
||||
end "+";
|
||||
|
||||
---------
|
||||
-- "-" --
|
||||
---------
|
||||
|
||||
function "-"
|
||||
(Left : CPU_Time;
|
||||
Right : Ada.Real_Time.Time_Span) return CPU_Time
|
||||
is
|
||||
use type Ada.Real_Time.Time;
|
||||
begin
|
||||
return CPU_Time (Ada.Real_Time.Time (Left) - Right);
|
||||
end "-";
|
||||
|
||||
function "-"
|
||||
(Left : CPU_Time;
|
||||
Right : CPU_Time) return Ada.Real_Time.Time_Span
|
||||
is
|
||||
use type Ada.Real_Time.Time;
|
||||
begin
|
||||
return (Ada.Real_Time.Time (Left) - Ada.Real_Time.Time (Right));
|
||||
end "-";
|
||||
|
||||
-----------
|
||||
-- Clock --
|
||||
-----------
|
||||
|
||||
function Clock
|
||||
(T : Ada.Task_Identification.Task_Id :=
|
||||
Ada.Task_Identification.Current_Task)
|
||||
return CPU_Time
|
||||
is
|
||||
TS : aliased timespec;
|
||||
Result : Interfaces.C.int;
|
||||
|
||||
function To_CPU_Time is
|
||||
new Ada.Unchecked_Conversion (Duration, CPU_Time);
|
||||
-- Time is equal to Duration (although it is a private type) and
|
||||
-- CPU_Time is equal to Time.
|
||||
|
||||
function clock_gettime
|
||||
(clock_id : Interfaces.C.int;
|
||||
tp : access timespec)
|
||||
return int;
|
||||
pragma Import (C, clock_gettime, "clock_gettime");
|
||||
-- Function from the POSIX.1b Realtime Extensions library
|
||||
|
||||
CLOCK_THREAD_CPUTIME_ID : constant := 3;
|
||||
-- Identifier for the clock returning per-task CPU time
|
||||
|
||||
begin
|
||||
if T = Ada.Task_Identification.Null_Task_Id then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
Result := clock_gettime
|
||||
(clock_id => CLOCK_THREAD_CPUTIME_ID, tp => TS'Unchecked_Access);
|
||||
pragma Assert (Result = 0);
|
||||
|
||||
return To_CPU_Time (To_Duration (TS));
|
||||
end Clock;
|
||||
|
||||
-----------
|
||||
-- Split --
|
||||
-----------
|
||||
|
||||
procedure Split
|
||||
(T : CPU_Time;
|
||||
SC : out Ada.Real_Time.Seconds_Count;
|
||||
TS : out Ada.Real_Time.Time_Span)
|
||||
is
|
||||
use type Ada.Real_Time.Time;
|
||||
begin
|
||||
Ada.Real_Time.Split (Ada.Real_Time.Time (T), SC, TS);
|
||||
end Split;
|
||||
|
||||
-------------
|
||||
-- Time_Of --
|
||||
-------------
|
||||
|
||||
function Time_Of
|
||||
(SC : Ada.Real_Time.Seconds_Count;
|
||||
TS : Ada.Real_Time.Time_Span := Ada.Real_Time.Time_Span_Zero)
|
||||
return CPU_Time
|
||||
is
|
||||
begin
|
||||
return CPU_Time (Ada.Real_Time.Time_Of (SC, TS));
|
||||
end Time_Of;
|
||||
|
||||
end Ada.Execution_Time;
|
||||
|
|
@ -10428,7 +10428,7 @@ package body Exp_Ch9 is
|
|||
|
||||
-- Add the _Priority component if a Priority pragma is present
|
||||
|
||||
if Present (Taskdef) and then Has_Priority_Pragma (Taskdef) then
|
||||
if Present (Taskdef) and then Has_Pragma_Priority (Taskdef) then
|
||||
declare
|
||||
Prag : constant Node_Id :=
|
||||
Find_Task_Or_Protected_Pragma (Taskdef, Name_Priority);
|
||||
|
|
@ -12057,7 +12057,7 @@ package body Exp_Ch9 is
|
|||
-- defined value, see D.3(10).
|
||||
|
||||
if Present (Pdef)
|
||||
and then Has_Priority_Pragma (Pdef)
|
||||
and then Has_Pragma_Priority (Pdef)
|
||||
then
|
||||
declare
|
||||
Prio : constant Node_Id :=
|
||||
|
|
@ -12357,7 +12357,7 @@ package body Exp_Ch9 is
|
|||
-- Priority parameter. Set to Unspecified_Priority unless there is a
|
||||
-- priority pragma, in which case we take the value from the pragma.
|
||||
|
||||
if Present (Tdef) and then Has_Priority_Pragma (Tdef) then
|
||||
if Present (Tdef) and then Has_Pragma_Priority (Tdef) then
|
||||
Append_To (Args,
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Make_Identifier (Loc, Name_uInit),
|
||||
|
|
|
|||
|
|
@ -1618,19 +1618,19 @@ ada/errout.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
|||
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
|
||||
|
||||
ada/erroutc.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
|
||||
ada/casing.ads ada/debug.ads ada/einfo.ads ada/err_vars.ads \
|
||||
ada/erroutc.ads ada/erroutc.adb ada/hostparm.ads ada/interfac.ads \
|
||||
ada/namet.ads ada/namet.adb ada/nlists.ads ada/opt.ads ada/output.ads \
|
||||
ada/output.adb ada/rident.ads ada/sinfo.ads ada/sinput.ads \
|
||||
ada/sinput.adb ada/snames.ads ada/system.ads ada/s-exctab.ads \
|
||||
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
|
||||
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
|
||||
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
|
||||
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
|
||||
ada/table.adb ada/targparm.ads ada/tree_io.ads ada/types.ads \
|
||||
ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
|
||||
ada/widechar.ads
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
|
||||
ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
|
||||
ada/err_vars.ads ada/erroutc.ads ada/erroutc.adb ada/hostparm.ads \
|
||||
ada/interfac.ads ada/namet.ads ada/namet.adb ada/nlists.ads ada/opt.ads \
|
||||
ada/output.ads ada/output.adb ada/rident.ads ada/sinfo.ads \
|
||||
ada/sinput.ads ada/sinput.adb ada/snames.ads ada/system.ads \
|
||||
ada/s-exctab.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
|
||||
ada/s-parame.ads ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads \
|
||||
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
|
||||
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
|
||||
ada/table.ads ada/table.adb ada/targparm.ads ada/tree_io.ads \
|
||||
ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
|
||||
ada/urealp.ads ada/widechar.ads
|
||||
|
||||
ada/eval_fat.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
|
||||
|
|
@ -2642,19 +2642,19 @@ ada/inline.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
|||
ada/uname.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
|
||||
|
||||
ada/instpar.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
|
||||
ada/casing.ads ada/debug.ads ada/einfo.ads ada/gnatvsn.ads \
|
||||
ada/hostparm.ads ada/instpar.ads ada/instpar.adb ada/interfac.ads \
|
||||
ada/namet.ads ada/nlists.ads ada/opt.ads ada/output.ads \
|
||||
ada/sdefault.ads ada/sinfo.ads ada/sinput.ads ada/sinput.adb \
|
||||
ada/sinput-l.ads ada/snames.ads ada/system.ads ada/s-carun8.ads \
|
||||
ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads ada/s-imenne.ads \
|
||||
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
|
||||
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
|
||||
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
|
||||
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
|
||||
ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
|
||||
ada/urealp.ads ada/widechar.ads
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
|
||||
ada/atree.adb ada/casing.ads ada/debug.ads ada/einfo.ads \
|
||||
ada/gnatvsn.ads ada/hostparm.ads ada/instpar.ads ada/instpar.adb \
|
||||
ada/interfac.ads ada/namet.ads ada/nlists.ads ada/opt.ads \
|
||||
ada/output.ads ada/sdefault.ads ada/sinfo.ads ada/sinput.ads \
|
||||
ada/sinput.adb ada/sinput-l.ads ada/snames.ads ada/system.ads \
|
||||
ada/s-carun8.ads ada/s-crc32.ads ada/s-crc32.adb ada/s-exctab.ads \
|
||||
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
|
||||
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
|
||||
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
|
||||
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
|
||||
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
|
||||
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
|
||||
|
||||
ada/interfac.o : ada/interfac.ads ada/system.ads
|
||||
|
||||
|
|
@ -2978,8 +2978,8 @@ ada/prep.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
|||
ada/unchdeal.ads ada/urealp.ads
|
||||
|
||||
ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
|
||||
ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
|
||||
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
|
||||
ada/err_vars.ads ada/errout.ads ada/erroutc.ads ada/gnat.ads \
|
||||
ada/g-dyntab.ads ada/g-dyntab.adb ada/g-hesorg.ads ada/hostparm.ads \
|
||||
ada/interfac.ads ada/lib.ads ada/lib-writ.ads ada/namet.ads \
|
||||
|
|
@ -4377,8 +4377,8 @@ ada/tbuild.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
|||
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
|
||||
|
||||
ada/tree_gen.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \
|
||||
ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
|
||||
ada/casing.ads ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
|
||||
ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/opt.ads \
|
||||
ada/osint.ads ada/osint-c.ads ada/output.ads ada/repinfo.ads \
|
||||
ada/sem_aux.ads ada/sinfo.ads ada/sinput.ads ada/snames.ads \
|
||||
|
|
@ -4391,16 +4391,17 @@ ada/tree_gen.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
|||
ada/urealp.ads
|
||||
|
||||
ada/tree_in.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/casing.ads \
|
||||
ada/csets.ads ada/debug.ads ada/einfo.ads ada/elists.ads ada/fname.ads \
|
||||
ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads ada/opt.ads \
|
||||
ada/output.ads ada/repinfo.ads ada/sem_aux.ads ada/sinfo.ads \
|
||||
ada/sinput.ads ada/snames.ads ada/stand.ads ada/stringt.ads \
|
||||
ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \
|
||||
ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
|
||||
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
|
||||
ada/tree_in.ads ada/tree_in.adb ada/tree_io.ads ada/types.ads \
|
||||
ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
|
||||
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
|
||||
ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads ada/elists.ads \
|
||||
ada/fname.ads ada/hostparm.ads ada/lib.ads ada/namet.ads ada/nlists.ads \
|
||||
ada/opt.ads ada/output.ads ada/repinfo.ads ada/sem_aux.ads \
|
||||
ada/sinfo.ads ada/sinput.ads ada/snames.ads ada/stand.ads \
|
||||
ada/stringt.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
|
||||
ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
|
||||
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
|
||||
ada/table.adb ada/tree_in.ads ada/tree_in.adb ada/tree_io.ads \
|
||||
ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
|
||||
ada/urealp.ads
|
||||
|
||||
ada/tree_io.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
|
||||
ada/a-uncdea.ads ada/debug.ads ada/hostparm.ads ada/output.ads \
|
||||
|
|
|
|||
|
|
@ -1074,6 +1074,8 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
|
|||
THREADSLIB = -lmarte
|
||||
else
|
||||
LIBGNAT_TARGET_PAIRS += \
|
||||
a-exetim.adb<a-exetim-posix.adb \
|
||||
a-exetim.ads<a-exetim-default.ads \
|
||||
s-linux.ads<s-linux.ads \
|
||||
s-osinte.adb<s-osinte-posix.adb
|
||||
|
||||
|
|
@ -1099,9 +1101,9 @@ ifeq ($(strip $(filter-out %86 linux%,$(arch) $(osys))),)
|
|||
EH_MECHANISM=-gcc
|
||||
endif
|
||||
|
||||
THREADSLIB = -lpthread
|
||||
THREADSLIB = -lpthread -lrt
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
|
||||
endif
|
||||
|
||||
TOOLS_TARGET_PAIRS = \
|
||||
|
|
@ -1785,6 +1787,8 @@ endif
|
|||
|
||||
ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
|
||||
LIBGNAT_TARGET_PAIRS_COMMON = \
|
||||
a-exetim.adb<a-exetim-posix.adb \
|
||||
a-exetim.ads<a-exetim-default.ads \
|
||||
a-intnam.ads<a-intnam-linux.ads \
|
||||
s-inmaop.adb<s-inmaop-posix.adb \
|
||||
s-intman.adb<s-intman-posix.adb \
|
||||
|
|
@ -1836,9 +1840,9 @@ ifeq ($(strip $(filter-out powerpc% linux%,$(arch) $(osys))),)
|
|||
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
|
||||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
|
||||
EH_MECHANISM=-gcc
|
||||
THREADSLIB = -lpthread
|
||||
THREADSLIB = -lpthread -lrt
|
||||
GNATLIB_SHARED = gnatlib-shared-dual
|
||||
GMEM_LIB = gmemlib
|
||||
LIBRARY_VERSION := $(LIB_VERSION)
|
||||
|
|
@ -1983,6 +1987,8 @@ endif
|
|||
|
||||
ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
|
||||
LIBGNAT_TARGET_PAIRS = \
|
||||
a-exetim.adb<a-exetim-posix.adb \
|
||||
a-exetim.ads<a-exetim-default.ads \
|
||||
a-intnam.ads<a-intnam-linux.ads \
|
||||
a-numaux.ads<a-numaux-libc-x86.ads \
|
||||
s-inmaop.adb<s-inmaop-posix.adb \
|
||||
|
|
@ -2004,10 +2010,10 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
|
|||
mlib-tgt-specific.adb<mlib-tgt-specific-linux.adb \
|
||||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
|
||||
EH_MECHANISM=-gcc
|
||||
MISCLIB=
|
||||
THREADSLIB=-lpthread
|
||||
THREADSLIB=-lpthread -lrt
|
||||
GNATLIB_SHARED=gnatlib-shared-dual
|
||||
GMEM_LIB = gmemlib
|
||||
LIBRARY_VERSION := $(LIB_VERSION)
|
||||
|
|
@ -2072,6 +2078,8 @@ endif
|
|||
|
||||
ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
|
||||
LIBGNAT_TARGET_PAIRS = \
|
||||
a-exetim.adb<a-exetim-posix.adb \
|
||||
a-exetim.ads<a-exetim-default.ads \
|
||||
a-intnam.ads<a-intnam-linux.ads \
|
||||
a-numaux.adb<a-numaux-x86.adb \
|
||||
a-numaux.ads<a-numaux-x86.ads \
|
||||
|
|
@ -2095,9 +2103,9 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
|
|||
indepsw.adb<indepsw-gnu.adb
|
||||
|
||||
EXTRA_GNATRTL_NONTASKING_OBJS=g-sse.o g-ssvety.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o
|
||||
EXTRA_GNATRTL_TASKING_OBJS=s-linux.o a-exetim.o
|
||||
EH_MECHANISM=-gcc
|
||||
THREADSLIB=-lpthread
|
||||
THREADSLIB=-lpthread -lrt
|
||||
GNATLIB_SHARED=gnatlib-shared-dual
|
||||
GMEM_LIB = gmemlib
|
||||
LIBRARY_VERSION := $(LIB_VERSION)
|
||||
|
|
|
|||
|
|
@ -4815,11 +4815,13 @@ pragma Suppress_All;
|
|||
@end smallexample
|
||||
|
||||
@noindent
|
||||
This pragma can only appear immediately following a compilation
|
||||
unit. The effect is to apply @code{Suppress (All_Checks)} to the unit
|
||||
which it follows. This pragma is implemented for compatibility with DEC
|
||||
Ada 83 usage. The use of pragma @code{Suppress (All_Checks)} as a normal
|
||||
configuration pragma is the preferred usage in GNAT@.
|
||||
This pragma can appear anywhere within a unit.
|
||||
The effect is to apply @code{Suppress (All_Checks)} to the unit
|
||||
in which it appears. This pragma is implemented for compatibility with DEC
|
||||
Ada 83 usage where it appears at the end of a unit, and for compatibility
|
||||
with Rational Ada, where it appears as a program unit pragma.
|
||||
The use of the standard Ada pragma @code{Suppress (All_Checks)}
|
||||
as a normal configuration pragma is the preferred usage in GNAT@.
|
||||
|
||||
@node Pragma Suppress_Exception_Locations
|
||||
@unnumberedsec Pragma Suppress_Exception_Locations
|
||||
|
|
|
|||
|
|
@ -549,7 +549,7 @@ package Lib.Xref is
|
|||
-- g C/C++ macro C/C++ fun-like macro
|
||||
-- h Interface (Ada 2005) Abstract type
|
||||
-- i signed integer object signed integer type
|
||||
-- j (unused) (unused)
|
||||
-- j C++ class object C++ class
|
||||
-- k generic package package
|
||||
-- l label on loop label on statement
|
||||
-- m modular integer object modular integer type
|
||||
|
|
|
|||
|
|
@ -982,6 +982,33 @@ begin
|
|||
end if;
|
||||
end Style_Checks;
|
||||
|
||||
-------------------------
|
||||
-- Suppress_All (GNAT) --
|
||||
-------------------------
|
||||
|
||||
-- pragma Suppress_All
|
||||
|
||||
-- This is a rather odd pragma, because other compilers allow it in
|
||||
-- strange places. DEC allows it at the end of units, and Rational
|
||||
-- allows it as a program unit pragma, when it would be more natural
|
||||
-- if it were a configuration pragma.
|
||||
|
||||
-- Since the reason we provide this pragma is for compatibility with
|
||||
-- these other compilers, we want to accomodate these strange placement
|
||||
-- rules, and the easiest thing is simply to allow it anywhere in a
|
||||
-- unit. If this pragma appears anywhere within a unit, then the effect
|
||||
-- is as though a pragma Suppress (All_Checks) had appeared as the first
|
||||
-- line of the current file, i.e. as the first configuration pragma in
|
||||
-- the current unit.
|
||||
|
||||
-- To get this effect, we set the flag Has_Pragma_Suppress_All in the
|
||||
-- compilation unit node for the current source file then in the last
|
||||
-- stage of parsing a file, if this flag is set, we materialize the
|
||||
-- Suppress (All_Checks) pragma, marked as not coming from Source.
|
||||
|
||||
when Pragma_Suppress_All =>
|
||||
Set_Has_Pragma_Suppress_All (Cunit (Current_Source_Unit));
|
||||
|
||||
---------------------
|
||||
-- Warnings (GNAT) --
|
||||
---------------------
|
||||
|
|
@ -1204,7 +1231,6 @@ begin
|
|||
Pragma_Stream_Convert |
|
||||
Pragma_Subtitle |
|
||||
Pragma_Suppress |
|
||||
Pragma_Suppress_All |
|
||||
Pragma_Suppress_Debug_Info |
|
||||
Pragma_Suppress_Exception_Locations |
|
||||
Pragma_Suppress_Initialization |
|
||||
|
|
|
|||
|
|
@ -50,6 +50,7 @@ with Sem_Res; use Sem_Res;
|
|||
with Sem_Type; use Sem_Type;
|
||||
with Sem_Util; use Sem_Util;
|
||||
with Sem_Warn; use Sem_Warn;
|
||||
with Sinput; use Sinput;
|
||||
with Snames; use Snames;
|
||||
with Stand; use Stand;
|
||||
with Sinfo; use Sinfo;
|
||||
|
|
@ -81,10 +82,10 @@ package body Sem_Ch13 is
|
|||
-- posted as required, and a value of No_Uint is returned.
|
||||
|
||||
function Is_Operational_Item (N : Node_Id) return Boolean;
|
||||
-- A specification for a stream attribute is allowed before the full
|
||||
-- type is declared, as explained in AI-00137 and the corrigendum.
|
||||
-- Attributes that do not specify a representation characteristic are
|
||||
-- operational attributes.
|
||||
-- A specification for a stream attribute is allowed before the full type
|
||||
-- is declared, as explained in AI-00137 and the corrigendum. Attributes
|
||||
-- that do not specify a representation characteristic are operational
|
||||
-- attributes.
|
||||
|
||||
procedure New_Stream_Subprogram
|
||||
(N : Node_Id;
|
||||
|
|
@ -666,6 +667,7 @@ package body Sem_Ch13 is
|
|||
Loc : constant Source_Ptr := Sloc (Aspect);
|
||||
Id : constant Node_Id := Identifier (Aspect);
|
||||
Expr : constant Node_Id := Expression (Aspect);
|
||||
Eloc : Source_Ptr := Sloc (Expr);
|
||||
Nam : constant Name_Id := Chars (Id);
|
||||
A_Id : constant Aspect_Id := Get_Aspect_Id (Nam);
|
||||
Anod : Node_Id;
|
||||
|
|
@ -675,11 +677,15 @@ package body Sem_Ch13 is
|
|||
Set_Entity (Aspect, E);
|
||||
Ent := New_Occurrence_Of (E, Sloc (Id));
|
||||
|
||||
-- Check for duplicate aspect
|
||||
-- Check for duplicate aspect. Note that the Comes_From_Source
|
||||
-- test allows duplicate Pre/Post's that we generate internally
|
||||
-- to escape being flagged here.
|
||||
|
||||
Anod := First (L);
|
||||
while Anod /= Aspect loop
|
||||
if Nam = Chars (Identifier (Anod)) then
|
||||
if Nam = Chars (Identifier (Anod))
|
||||
and then Comes_From_Source (Aspect)
|
||||
then
|
||||
Error_Msg_Name_1 := Nam;
|
||||
Error_Msg_Sloc := Sloc (Anod);
|
||||
Error_Msg_NE
|
||||
|
|
@ -826,7 +832,7 @@ package body Sem_Ch13 is
|
|||
Aitem :=
|
||||
Make_Pragma (Loc,
|
||||
Pragma_Argument_Associations => New_List (
|
||||
New_Occurrence_Of (E, Sloc (Expr)),
|
||||
New_Occurrence_Of (E, Eloc),
|
||||
Relocate_Node (Expr)),
|
||||
Pragma_Identifier =>
|
||||
Make_Identifier (Sloc (Id), Chars (Id)));
|
||||
|
|
@ -848,7 +854,7 @@ package body Sem_Ch13 is
|
|||
Make_Pragma (Loc,
|
||||
Pragma_Argument_Associations => New_List (
|
||||
Relocate_Node (Expr),
|
||||
New_Occurrence_Of (E, Sloc (Expr))),
|
||||
New_Occurrence_Of (E, Eloc)),
|
||||
Pragma_Identifier =>
|
||||
Make_Identifier (Sloc (Id), Chars (Id)),
|
||||
Class_Present => Class_Present (Aspect));
|
||||
|
|
@ -858,53 +864,74 @@ package body Sem_Ch13 is
|
|||
|
||||
Delay_Required := False;
|
||||
|
||||
-- Aspect Pre corresponds to pragma Precondition with single
|
||||
-- argument that is the expression (we never give a message
|
||||
-- argument). This is inserted right after the declaration,
|
||||
-- to get the required pragma placement.
|
||||
-- Aspects Pre/Post generate Precondition/Postcondition pragmas
|
||||
-- with a first argument that is the expression, and a second
|
||||
-- argument that is an informative message if the test fails.
|
||||
-- This is inserted right after the declaration, to get the
|
||||
-- required pragma placement.
|
||||
|
||||
when Aspect_Pre =>
|
||||
when Aspect_Pre | Aspect_Post => declare
|
||||
Pname : Name_Id;
|
||||
Msg : Node_Id;
|
||||
|
||||
begin
|
||||
if A_Id = Aspect_Pre then
|
||||
Pname := Name_Precondition;
|
||||
else
|
||||
Pname := Name_Postcondition;
|
||||
end if;
|
||||
|
||||
-- If the expressions is of the form A and then B, then
|
||||
-- we generate separate Pre/Post aspects for the separate
|
||||
-- clauses. Since we allow multiple pragmas, there is no
|
||||
-- problem in allowing multiple Pre/Post aspects internally.
|
||||
|
||||
while Nkind (Expr) = N_And_Then loop
|
||||
Insert_After (Aspect,
|
||||
Make_Aspect_Specification (Sloc (Right_Opnd (Expr)),
|
||||
Identifier => Identifier (Aspect),
|
||||
Expression => Relocate_Node (Right_Opnd (Expr)),
|
||||
Class_Present => Class_Present (Aspect)));
|
||||
Rewrite (Expr, Relocate_Node (Left_Opnd (Expr)));
|
||||
Eloc := Sloc (Expr);
|
||||
end loop;
|
||||
|
||||
-- Proceed with handling what's left after this split up
|
||||
|
||||
Msg :=
|
||||
Make_String_Literal (Eloc,
|
||||
Strval => "failed "
|
||||
& Get_Name_String (Pname)
|
||||
& " from line "
|
||||
& Get_Logical_Line_Number_Img (Eloc));
|
||||
|
||||
-- Construct the pragma
|
||||
|
||||
Aitem :=
|
||||
Make_Pragma (Loc,
|
||||
Pragma_Identifier =>
|
||||
Make_Identifier (Sloc (Id), Name_Precondition),
|
||||
Make_Identifier (Sloc (Id),
|
||||
Chars => Pname),
|
||||
Class_Present => Class_Present (Aspect),
|
||||
Pragma_Argument_Associations => New_List (
|
||||
Make_Pragma_Argument_Association (Sloc (Expr),
|
||||
Make_Pragma_Argument_Association (Eloc,
|
||||
Chars => Name_Check,
|
||||
Expression => Relocate_Node (Expr))));
|
||||
Expression => Relocate_Node (Expr)),
|
||||
Make_Pragma_Argument_Association (Eloc,
|
||||
Chars => Name_Message,
|
||||
Expression => Msg)));
|
||||
|
||||
-- We don't have to play the delay game here. The required
|
||||
-- delay in this case is already implemented by the pragma.
|
||||
Set_From_Aspect_Specification (Aitem, True);
|
||||
|
||||
Delay_Required := False;
|
||||
-- For Pre/Post cases, insert immediately after the entity
|
||||
-- declaration, since that is the required pragma placement.
|
||||
-- Note that for these aspects, we do not have to worry
|
||||
-- about delay issues, since the pragmas themselves deal
|
||||
-- with delay of visibility for the expression analysis.
|
||||
|
||||
-- Aspect Post corresponds to pragma Postcondition with single
|
||||
-- argument that is the expression (we never give a message
|
||||
-- argument. This is inserted right after the declaration,
|
||||
-- to get the required pragma placement.
|
||||
|
||||
when Aspect_Post =>
|
||||
|
||||
-- Construct the pragma
|
||||
|
||||
Aitem :=
|
||||
Make_Pragma (Sloc (Aspect),
|
||||
Pragma_Identifier =>
|
||||
Make_Identifier (Sloc (Id), Name_Postcondition),
|
||||
Class_Present => Class_Present (Aspect),
|
||||
Pragma_Argument_Associations => New_List (
|
||||
Make_Pragma_Argument_Association (Sloc (Expr),
|
||||
Chars => Name_Check,
|
||||
Expression => Relocate_Node (Expr))));
|
||||
|
||||
-- We don't have to play the delay game here. The required
|
||||
-- delay in this case is already implemented by the pragma.
|
||||
|
||||
Delay_Required := False;
|
||||
Insert_After (N, Aitem);
|
||||
goto Continue;
|
||||
end;
|
||||
|
||||
-- Aspects currently unimplemented
|
||||
|
||||
|
|
|
|||
|
|
@ -8970,11 +8970,11 @@ package body Sem_Prag is
|
|||
Pragma_Misplaced;
|
||||
return;
|
||||
|
||||
elsif Has_Priority_Pragma (P) then
|
||||
elsif Has_Pragma_Priority (P) then
|
||||
Error_Pragma ("duplicate pragma% not allowed");
|
||||
|
||||
else
|
||||
Set_Has_Priority_Pragma (P, True);
|
||||
Set_Has_Pragma_Priority (P, True);
|
||||
Record_Rep_Item (Defining_Identifier (Parent (P)), N);
|
||||
end if;
|
||||
end Interrupt_Priority;
|
||||
|
|
@ -10994,10 +10994,10 @@ package body Sem_Prag is
|
|||
Pragma_Misplaced;
|
||||
end if;
|
||||
|
||||
if Has_Priority_Pragma (P) then
|
||||
if Has_Pragma_Priority (P) then
|
||||
Error_Pragma ("duplicate pragma% not allowed");
|
||||
else
|
||||
Set_Has_Priority_Pragma (P, True);
|
||||
Set_Has_Pragma_Priority (P, True);
|
||||
|
||||
if Nkind_In (P, N_Protected_Definition, N_Task_Definition) then
|
||||
Record_Rep_Item (Defining_Identifier (Parent (P)), N);
|
||||
|
|
@ -12196,25 +12196,16 @@ package body Sem_Prag is
|
|||
|
||||
-- pragma Suppress_All;
|
||||
|
||||
-- The only check made here is that the pragma appears in the proper
|
||||
-- place, i.e. following a compilation unit. If indeed it appears in
|
||||
-- this context, then the parser has already inserted an equivalent
|
||||
-- pragma Suppress (All_Checks) to get the required effect.
|
||||
-- The only check made here is that the pragma has no arguments.
|
||||
-- There are no placement rules, and the processing required (setting
|
||||
-- the Has_Pragma_Suppress_All flag in the compilation unit node was
|
||||
-- taken care of by the parser). Process_Compilation_Unit_Pragmas
|
||||
-- then creates and inserts a pragma Suppress (All_Checks).
|
||||
|
||||
when Pragma_Suppress_All =>
|
||||
GNAT_Pragma;
|
||||
Check_Arg_Count (0);
|
||||
|
||||
if Nkind (Parent (N)) /= N_Compilation_Unit_Aux
|
||||
or else not Is_List_Member (N)
|
||||
or else List_Containing (N) /= Pragmas_After (Parent (N))
|
||||
then
|
||||
if not CodePeer_Mode then
|
||||
Error_Pragma
|
||||
("misplaced pragma%, must follow compilation unit");
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-------------------------
|
||||
-- Suppress_Debug_Info --
|
||||
-------------------------
|
||||
|
|
@ -13782,35 +13773,26 @@ package body Sem_Prag is
|
|||
procedure Process_Compilation_Unit_Pragmas (N : Node_Id) is
|
||||
begin
|
||||
-- A special check for pragma Suppress_All, a very strange DEC pragma,
|
||||
-- strange because it comes at the end of the unit. If we have a pragma
|
||||
-- Suppress_All in the Pragmas_After of the current unit, then we insert
|
||||
-- a pragma Suppress (All_Checks) at the start of the context clause to
|
||||
-- ensure the correct processing.
|
||||
-- strange because it comes at the end of the unit. Rational has the
|
||||
-- same name for a pragma, but treats it as a program unit pragma, In
|
||||
-- GNAT we just decide to allow it anywhere at all. If it appeared then
|
||||
-- the flag Has_Pragma_Suppress_All was set on the compilation unit
|
||||
-- node, and we insert a pragma Suppress (All_Checks) at the start of
|
||||
-- the context clause to ensure the correct processing.
|
||||
|
||||
declare
|
||||
PA : constant List_Id := Pragmas_After (Aux_Decls_Node (N));
|
||||
P : Node_Id;
|
||||
if Has_Pragma_Suppress_All (N) then
|
||||
Prepend_To (Context_Items (N),
|
||||
Make_Pragma (Sloc (N),
|
||||
Chars => Name_Suppress,
|
||||
Pragma_Argument_Associations => New_List (
|
||||
Make_Pragma_Argument_Association (Sloc (N),
|
||||
Expression =>
|
||||
Make_Identifier (Sloc (N),
|
||||
Chars => Name_All_Checks)))));
|
||||
end if;
|
||||
|
||||
begin
|
||||
if Present (PA) then
|
||||
P := First (PA);
|
||||
while Present (P) loop
|
||||
if Pragma_Name (P) = Name_Suppress_All then
|
||||
Prepend_To (Context_Items (N),
|
||||
Make_Pragma (Sloc (P),
|
||||
Chars => Name_Suppress,
|
||||
Pragma_Argument_Associations => New_List (
|
||||
Make_Pragma_Argument_Association (Sloc (P),
|
||||
Expression =>
|
||||
Make_Identifier (Sloc (P),
|
||||
Chars => Name_All_Checks)))));
|
||||
exit;
|
||||
end if;
|
||||
-- Nothing else to do at the current time!
|
||||
|
||||
Next (P);
|
||||
end loop;
|
||||
end if;
|
||||
end;
|
||||
end Process_Compilation_Unit_Pragmas;
|
||||
|
||||
--------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, 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- --
|
||||
|
|
@ -99,8 +99,8 @@ package Sem_Prag is
|
|||
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
|
||||
-- Called at the start of processing compilation unit N to deal with any
|
||||
-- special issues regarding pragmas. In particular, we have to deal with
|
||||
-- Suppress_All at this stage, since it appears after the unit instead of
|
||||
-- before.
|
||||
-- Suppress_All at this stage, since it can appear after the unit instead
|
||||
-- of before (actually we allow it to appear anywhere).
|
||||
|
||||
procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
|
||||
-- This routine is used to set an encoded interface name. The node S is an
|
||||
|
|
|
|||
|
|
@ -1453,7 +1453,7 @@ package body Sinfo is
|
|||
return Flag17 (N);
|
||||
end Has_No_Elaboration_Code;
|
||||
|
||||
function Has_Priority_Pragma
|
||||
function Has_Pragma_Priority
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
pragma Assert (False
|
||||
|
|
@ -1461,7 +1461,15 @@ package body Sinfo is
|
|||
or else NT (N).Nkind = N_Subprogram_Body
|
||||
or else NT (N).Nkind = N_Task_Definition);
|
||||
return Flag6 (N);
|
||||
end Has_Priority_Pragma;
|
||||
end Has_Pragma_Priority;
|
||||
|
||||
function Has_Pragma_Suppress_All
|
||||
(N : Node_Id) return Boolean is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Compilation_Unit);
|
||||
return Flag14 (N);
|
||||
end Has_Pragma_Suppress_All;
|
||||
|
||||
function Has_Private_View
|
||||
(N : Node_Id) return Boolean is
|
||||
|
|
@ -4406,7 +4414,7 @@ package body Sinfo is
|
|||
Set_Flag17 (N, Val);
|
||||
end Set_Has_No_Elaboration_Code;
|
||||
|
||||
procedure Set_Has_Priority_Pragma
|
||||
procedure Set_Has_Pragma_Priority
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
|
|
@ -4414,7 +4422,15 @@ package body Sinfo is
|
|||
or else NT (N).Nkind = N_Subprogram_Body
|
||||
or else NT (N).Nkind = N_Task_Definition);
|
||||
Set_Flag6 (N, Val);
|
||||
end Set_Has_Priority_Pragma;
|
||||
end Set_Has_Pragma_Priority;
|
||||
|
||||
procedure Set_Has_Pragma_Suppress_All
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
begin
|
||||
pragma Assert (False
|
||||
or else NT (N).Nkind = N_Compilation_Unit);
|
||||
Set_Flag14 (N, Val);
|
||||
end Set_Has_Pragma_Suppress_All;
|
||||
|
||||
procedure Set_Has_Private_View
|
||||
(N : Node_Id; Val : Boolean := True) is
|
||||
|
|
|
|||
|
|
@ -1133,7 +1133,16 @@ package Sinfo is
|
|||
-- generate elaboration code, and non-preelaborated packages which do
|
||||
-- not generate elaboration code.
|
||||
|
||||
-- Has_Priority_Pragma (Flag6-Sem)
|
||||
-- Has_Pragma_Suppress_All (Flag14-Sem)
|
||||
-- This flag is set in an N_Compilation_Unit node if the Suppress_All
|
||||
-- pragma appears anywhere in the unit. This accomodates the rather
|
||||
-- strange placement rules of other compilers (DEC permits it at the
|
||||
-- end of a unit, and Rational allows it as a program unit pragma). We
|
||||
-- allow it anywhere at all, and consider it equivalent to a pragma
|
||||
-- Suppress (All_Checks) appearing at the start of the configuration
|
||||
-- pragmas for the unit.
|
||||
|
||||
-- Has_Pragma_Priority (Flag6-Sem)
|
||||
-- A flag present in N_Subprogram_Body, N_Task_Definition and
|
||||
-- N_Protected_Definition nodes to flag the presence of either a Priority
|
||||
-- or Interrupt_Priority pragma in the declaration sequence (public or
|
||||
|
|
@ -4462,7 +4471,7 @@ package Sinfo is
|
|||
-- Acts_As_Spec (Flag4-Sem)
|
||||
-- Bad_Is_Detected (Flag15) used only by parser
|
||||
-- Do_Storage_Check (Flag17-Sem)
|
||||
-- Has_Priority_Pragma (Flag6-Sem)
|
||||
-- Has_Pragma_Priority (Flag6-Sem)
|
||||
-- Is_Protected_Subprogram_Body (Flag7-Sem)
|
||||
-- Is_Entry_Barrier_Function (Flag8-Sem)
|
||||
-- Is_Task_Master (Flag5-Sem)
|
||||
|
|
@ -4946,7 +4955,7 @@ package Sinfo is
|
|||
-- Visible_Declarations (List2)
|
||||
-- Private_Declarations (List3) (set to No_List if no private part)
|
||||
-- End_Label (Node4)
|
||||
-- Has_Priority_Pragma (Flag6-Sem)
|
||||
-- Has_Pragma_Priority (Flag6-Sem)
|
||||
-- Has_Storage_Size_Pragma (Flag5-Sem)
|
||||
-- Has_Task_Info_Pragma (Flag7-Sem)
|
||||
-- Has_Task_Name_Pragma (Flag8-Sem)
|
||||
|
|
@ -5033,7 +5042,7 @@ package Sinfo is
|
|||
-- Visible_Declarations (List2)
|
||||
-- Private_Declarations (List3) (set to No_List if no private part)
|
||||
-- End_Label (Node4)
|
||||
-- Has_Priority_Pragma (Flag6-Sem)
|
||||
-- Has_Pragma_Priority (Flag6-Sem)
|
||||
|
||||
------------------------------------------
|
||||
-- 9.4 Protected Operation Declaration --
|
||||
|
|
@ -5547,6 +5556,7 @@ package Sinfo is
|
|||
-- Acts_As_Spec (Flag4-Sem) flag for subprogram body with no spec
|
||||
-- Context_Pending (Flag16-Sem)
|
||||
-- First_Inlined_Subprogram (Node3-Sem)
|
||||
-- Has_Pragma_Suppress_All (Flag14-Sem)
|
||||
|
||||
-- N_Compilation_Unit_Aux
|
||||
-- Sloc is a copy of the Sloc from the N_Compilation_Unit node
|
||||
|
|
@ -8291,9 +8301,12 @@ package Sinfo is
|
|||
function Has_No_Elaboration_Code
|
||||
(N : Node_Id) return Boolean; -- Flag17
|
||||
|
||||
function Has_Priority_Pragma
|
||||
function Has_Pragma_Priority
|
||||
(N : Node_Id) return Boolean; -- Flag6
|
||||
|
||||
function Has_Pragma_Suppress_All
|
||||
(N : Node_Id) return Boolean; -- Flag14
|
||||
|
||||
function Has_Private_View
|
||||
(N : Node_Id) return Boolean; -- Flag11
|
||||
|
||||
|
|
@ -9233,9 +9246,12 @@ package Sinfo is
|
|||
procedure Set_Has_No_Elaboration_Code
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag17
|
||||
|
||||
procedure Set_Has_Priority_Pragma
|
||||
procedure Set_Has_Pragma_Priority
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag6
|
||||
|
||||
procedure Set_Has_Pragma_Suppress_All
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag14
|
||||
|
||||
procedure Set_Has_Private_View
|
||||
(N : Node_Id; Val : Boolean := True); -- Flag11
|
||||
|
||||
|
|
@ -11593,7 +11609,8 @@ package Sinfo is
|
|||
pragma Inline (Has_Local_Raise);
|
||||
pragma Inline (Has_Self_Reference);
|
||||
pragma Inline (Has_No_Elaboration_Code);
|
||||
pragma Inline (Has_Priority_Pragma);
|
||||
pragma Inline (Has_Pragma_Priority);
|
||||
pragma Inline (Has_Pragma_Suppress_All);
|
||||
pragma Inline (Has_Private_View);
|
||||
pragma Inline (Has_Relative_Deadline_Pragma);
|
||||
pragma Inline (Has_Storage_Size_Pragma);
|
||||
|
|
@ -11903,7 +11920,8 @@ package Sinfo is
|
|||
pragma Inline (Set_Has_Local_Raise);
|
||||
pragma Inline (Set_Has_Dynamic_Range_Check);
|
||||
pragma Inline (Set_Has_No_Elaboration_Code);
|
||||
pragma Inline (Set_Has_Priority_Pragma);
|
||||
pragma Inline (Set_Has_Pragma_Priority);
|
||||
pragma Inline (Set_Has_Pragma_Suppress_All);
|
||||
pragma Inline (Set_Has_Private_View);
|
||||
pragma Inline (Set_Has_Relative_Deadline_Pragma);
|
||||
pragma Inline (Set_Has_Storage_Size_Pragma);
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, 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- --
|
||||
|
|
@ -227,8 +227,7 @@ package body Sinput is
|
|||
Get_Name_String_And_Append
|
||||
(Reference_Name (Get_Source_File_Index (Ptr)));
|
||||
Add_Char_To_Name_Buffer (':');
|
||||
Add_Nat_To_Name_Buffer
|
||||
(Nat (Get_Logical_Line_Number (Ptr)));
|
||||
Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (Ptr)));
|
||||
|
||||
Ptr := Instantiation_Location (Ptr);
|
||||
exit when Ptr = No_Location;
|
||||
|
|
@ -299,6 +298,19 @@ package body Sinput is
|
|||
end if;
|
||||
end Get_Logical_Line_Number;
|
||||
|
||||
---------------------------------
|
||||
-- Get_Logical_Line_Number_Img --
|
||||
---------------------------------
|
||||
|
||||
function Get_Logical_Line_Number_Img
|
||||
(P : Source_Ptr) return String
|
||||
is
|
||||
begin
|
||||
Name_Len := 0;
|
||||
Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (P)));
|
||||
return Name_Buffer (1 .. Name_Len);
|
||||
end Get_Logical_Line_Number_Img;
|
||||
|
||||
------------------------------
|
||||
-- Get_Physical_Line_Number --
|
||||
------------------------------
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2010, 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- --
|
||||
|
|
@ -487,6 +487,11 @@ package Sinput is
|
|||
-- reference pragmas have been encountered, the value returned is
|
||||
-- the same as the physical line number.
|
||||
|
||||
function Get_Logical_Line_Number_Img
|
||||
(P : Source_Ptr) return String;
|
||||
-- Same as above function, but returns the line number as a string of
|
||||
-- decimal digits, with no leading space. Destroys Name_Buffer.
|
||||
|
||||
function Get_Physical_Line_Number
|
||||
(P : Source_Ptr) return Physical_Line_Number;
|
||||
-- The line number of the specified source position is obtained by
|
||||
|
|
|
|||
Loading…
Reference in New Issue