OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* sem_attr.adb (Eval_Attribute): Ensure that attribute
	reference is not marked as being a static expression if the
	prefix evaluation raises CE.

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* exp_pakd.adb: Move bit packed entity tables to spec.
	* exp_pakd.ads: Move bit packed entity tables here from body.
	* freeze.adb (Freeze_Array_Type): Check that packed array type
	is supported.
	* rtsfind.adb (PRE_Id_Table): New table (Entity_Not_Defined):
	Specialize messages using PRE_Id_Table.
	* uintp.ads, uintp.adb (UI_Image): New functional form.

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* aspects.ads, aspects.adb: Add Suppress_Initialization aspect.
	* einfo.ads, einfo.adb (Suppress_Initialization): Now applies to
	E_Variable.
	* exp_ch3.adb (Default_Initialize_Object): Handle
	Suppress_Initialization.
	* exp_prag.adb (Expand_Pragma_Suppress_Initialization): New
	procedure (Expand_N_Pragma): Handle Suppress_Initialization
	(Expand_Pragma_Import_Or_Interface): Use Undo_Initialization
	(Undo_Initialization): New procedure.
	* sem_prag.adb (Analyze_Pragma, case Suppress_Initialization):
	This is now allowed for E_Variable case.
	* gnat_rm.texi: Document new aspect Suppress_Initialization
	Suppress_Initialization aspect/pragma can apply to variable.
	* einfo.ads: Minor reformatting.

2014-10-17  Arnaud Charlet  <charlet@adacore.com>

	* spark_xrefs.ads: Add documentation pointer to Flow_Computed_Globals.

2014-10-17  Robert Dewar  <dewar@adacore.com>

	* cstand.adb (Create_Standard): Mark Short_Integer as
	implementation defined.
	* sem_util.adb (Set_Entity_With_Checks): Avoid blow up for
	compiler built with assertions for No_Implementation_Identifiers test.

From-SVN: r216379
This commit is contained in:
Arnaud Charlet 2014-10-17 11:07:50 +02:00
parent 99bd87dd98
commit 99425ec329
19 changed files with 704 additions and 445 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
gcc/ada/ChangeLog
View File

@ -1,3 +1,47 @@
2014-10-17 Robert Dewar <dewar@adacore.com>
* sem_attr.adb (Eval_Attribute): Ensure that attribute
reference is not marked as being a static expression if the
prefix evaluation raises CE.
2014-10-17 Robert Dewar <dewar@adacore.com>
* exp_pakd.adb: Move bit packed entity tables to spec.
* exp_pakd.ads: Move bit packed entity tables here from body.
* freeze.adb (Freeze_Array_Type): Check that packed array type
is supported.
* rtsfind.adb (PRE_Id_Table): New table (Entity_Not_Defined):
Specialize messages using PRE_Id_Table.
* uintp.ads, uintp.adb (UI_Image): New functional form.
2014-10-17 Robert Dewar <dewar@adacore.com>
* aspects.ads, aspects.adb: Add Suppress_Initialization aspect.
* einfo.ads, einfo.adb (Suppress_Initialization): Now applies to
E_Variable.
* exp_ch3.adb (Default_Initialize_Object): Handle
Suppress_Initialization.
* exp_prag.adb (Expand_Pragma_Suppress_Initialization): New
procedure (Expand_N_Pragma): Handle Suppress_Initialization
(Expand_Pragma_Import_Or_Interface): Use Undo_Initialization
(Undo_Initialization): New procedure.
* sem_prag.adb (Analyze_Pragma, case Suppress_Initialization):
This is now allowed for E_Variable case.
* gnat_rm.texi: Document new aspect Suppress_Initialization
Suppress_Initialization aspect/pragma can apply to variable.
* einfo.ads: Minor reformatting.
2014-10-17 Arnaud Charlet <charlet@adacore.com>
* spark_xrefs.ads: Add documentation pointer to Flow_Computed_Globals.
2014-10-17 Robert Dewar <dewar@adacore.com>
* cstand.adb (Create_Standard): Mark Short_Integer as
implementation defined.
* sem_util.adb (Set_Entity_With_Checks): Avoid blow up for
compiler built with assertions for No_Implementation_Identifiers test.
2014-10-17 Robert Dewar <dewar@adacore.com>
* aspects.ads: Documentation fix, aspect Lock_Free does have a

1
gcc/ada/aspects.adb
View File

@ -585,6 +585,7 @@ package body Aspects is
Aspect_Stream_Size => Aspect_Stream_Size,
Aspect_Suppress => Aspect_Suppress,
Aspect_Suppress_Debug_Info => Aspect_Suppress_Debug_Info,
Aspect_Suppress_Initialization => Aspect_Suppress_Initialization,
Aspect_Synchronization => Aspect_Synchronization,
Aspect_Test_Case => Aspect_Test_Case,
Aspect_Thread_Local_Storage => Aspect_Thread_Local_Storage,

4
gcc/ada/aspects.ads
View File

@ -188,6 +188,7 @@ package Aspects is
Aspect_Shared, -- GNAT (equivalent to Atomic)
Aspect_Simple_Storage_Pool_Type, -- GNAT
Aspect_Suppress_Debug_Info, -- GNAT
Aspect_Suppress_Initialization, -- GNAT
Aspect_Thread_Local_Storage, -- GNAT
Aspect_Unchecked_Union,
Aspect_Universal_Aliasing, -- GNAT
@ -243,6 +244,7 @@ package Aspects is
Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True,
Aspect_Suppress_Initialization => True,
Aspect_Thread_Local_Storage => True,
Aspect_Test_Case => True,
Aspect_Universal_Aliasing => True,
@ -469,6 +471,7 @@ package Aspects is
Aspect_Stream_Size => Name_Stream_Size,
Aspect_Suppress => Name_Suppress,
Aspect_Suppress_Debug_Info => Name_Suppress_Debug_Info,
Aspect_Suppress_Initialization => Name_Suppress_Initialization,
Aspect_Thread_Local_Storage => Name_Thread_Local_Storage,
Aspect_Synchronization => Name_Synchronization,
Aspect_Test_Case => Name_Test_Case,
@ -659,6 +662,7 @@ package Aspects is
Aspect_Stream_Size => Always_Delay,
Aspect_Suppress => Always_Delay,
Aspect_Suppress_Debug_Info => Always_Delay,
Aspect_Suppress_Initialization => Always_Delay,
Aspect_Thread_Local_Storage => Always_Delay,
Aspect_Type_Invariant => Always_Delay,
Aspect_Unchecked_Union => Always_Delay,

1
gcc/ada/cstand.adb
View File

@ -735,6 +735,7 @@ package body CStand is
Build_Signed_Integer_Type
(Standard_Short_Integer, Standard_Short_Integer_Size);
Set_Is_Implementation_Defined (Standard_Short_Integer);
Build_Signed_Integer_Type
(Standard_Integer, Standard_Integer_Size);

4
gcc/ada/einfo.adb
View File

@ -3090,7 +3090,7 @@ package body Einfo is
function Suppress_Initialization (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
return Flag105 (Id);
end Suppress_Initialization;
@ -5943,7 +5943,7 @@ package body Einfo is
procedure Set_Suppress_Initialization (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id));
pragma Assert (Is_Type (Id) or else Ekind (Id) = E_Variable);
Set_Flag105 (Id, V);
end Set_Suppress_Initialization;

66
gcc/ada/einfo.ads
View File

@ -2990,7 +2990,7 @@ package Einfo is
-- vtable (i.e. the one to be extended by derivation).
-- Is_Tagged_Type (Flag55)
-- Defined in all entities. Set for an entity for a tagged type.
-- Defined in all entities. Set for an entity that is a tagged type.
-- Is_Task_Interface (synthesized)
-- Defined in types that are interfaces. True if interface is declared as
@ -4081,14 +4081,16 @@ package Einfo is
-- avoid multiple elaboration warnings for the same variable.
-- Suppress_Initialization (Flag105)
-- Defined in all type and subtype entities. If set for the base type,
-- then the generation of initialization procedures is suppressed for the
-- type. Any other implicit initialiation (e.g. from the use of pragma
-- Initialize_Scalars) is also suppressed if this flag is set either for
-- the subtype in question, or for the base type. Set by use of pragma
-- Suppress_Initialization and also for internal entities where we know
-- that no initialization is required. For example, enumeration image
-- table entities set it.
-- Defined in all variable, type and subtype entities. If set for a base
-- type, then the generation of initialization procedures is suppressed
-- for the type. Any other implicit initialiation (e.g. from the use of
-- pragma Initialize_Scalars) is also suppressed if this flag is set for
-- either the subtype in question, or for the base type. For variables,
-- this flag suppresses all implicit initialization for the object, even
-- if the type would normally require initialization. Set by use of
-- pragma Suppress_Initialization and also for internal entities where
-- we know that no initialization is required. For example, enumeration
-- image table entities set it.
-- Suppress_Style_Checks (Flag165)
-- Defined in all entities. Suppresses any style checks specifically
@ -4481,8 +4483,8 @@ package Einfo is
-- is created for the base type, and this is the first named subtype).
E_Ordinary_Fixed_Point_Type,
-- Ordinary fixed type, used for the anonymous base type of the
-- fixed subtype created by an ordinary fixed point type declaration.
-- Ordinary fixed type, used for the anonymous base type of the fixed
-- subtype created by an ordinary fixed point type declaration.
E_Ordinary_Fixed_Point_Subtype,
-- Ordinary fixed point subtype, created by either an ordinary fixed
@ -4603,19 +4605,18 @@ package Einfo is
-- A record subtype, created by a record subtype declaration
E_Record_Type_With_Private,
-- Used for types defined by a private extension declaration, and
-- for tagged private types. Includes the fields for both private
-- types and for record types (with the sole exception of
-- Corresponding_Concurrent_Type which is obviously not needed).
-- This entity is considered to be both a record type and
-- a private type.
-- Used for types defined by a private extension declaration,
-- and for tagged private types. Includes the fields for both
-- private types and for record types (with the sole exception of
-- Corresponding_Concurrent_Type which is obviously not needed). This
-- entity is considered to be both a record type and a private type.
E_Record_Subtype_With_Private,
-- A subtype of a type defined by a private extension declaration
E_Private_Type,
-- A private type, created by a private type declaration
-- that has neither the keyword limited nor the keyword tagged.
-- A private type, created by a private type declaration that has
-- neither the keyword limited nor the keyword tagged.
E_Private_Subtype,
-- A subtype of a private type, created by a subtype declaration used
@ -4662,10 +4663,10 @@ package Einfo is
-- The type of an exception created by an exception declaration
E_Subprogram_Type,
-- This is the designated type of an Access_To_Subprogram. Has type
-- and signature like a subprogram entity, so can appear in calls,
-- which are resolved like regular calls, except that such an entity
-- is not overloadable.
-- This is the designated type of an Access_To_Subprogram. Has type and
-- signature like a subprogram entity, so can appear in calls, which
-- are resolved like regular calls, except that such an entity is not
-- overloadable.
---------------------------
-- Overloadable Entities --
@ -4681,9 +4682,9 @@ package Einfo is
E_Operator,
-- A predefined operator, appearing in Standard, or an implicitly
-- defined concatenation operator created whenever an array is
-- declared. We do not make normal derived operators explicit in
-- the tree, but the concatenation operators are made explicit.
-- defined concatenation operator created whenever an array is declared.
-- We do not make normal derived operators explicit in the tree, but the
-- concatenation operators are made explicit.
E_Procedure,
-- A procedure, created by a procedure declaration or a procedure
@ -6238,6 +6239,7 @@ package Einfo is
-- OK_To_Rename (Flag247)
-- Optimize_Alignment_Space (Flag241)
-- Optimize_Alignment_Time (Flag242)
-- Suppress_Initialization (Flag105)
-- Treat_As_Volatile (Flag41)
-- Address_Clause (synth)
-- Alignment_Clause (synth)
@ -8794,12 +8796,12 @@ package Einfo is
-- END XEINFO INLINES
-- The following Inline pragmas are *not* read by xeinfo when building
-- the C version of this interface automatically (so the C version will
-- end up making out of line calls). The pragma scan in xeinfo will be
-- terminated on encountering the END XEINFO INLINES line. We inline
-- things here which are small, but not of the canonical attribute
-- access/set format that can be handled by xeinfo.
-- The following Inline pragmas are *not* read by xeinfo when building the
-- C version of this interface automatically (so the C version will end up
-- making out of line calls). The pragma scan in xeinfo will be terminated
-- on encountering the END XEINFO INLINES line. We inline things here which
-- are small, but not of the canonical attribute access/set format that can
-- be handled by xeinfo.
pragma Inline (Base_Type);
pragma Inline (Is_Base_Type);

5
gcc/ada/exp_ch3.adb
View File

@ -5082,9 +5082,10 @@ package body Exp_Ch3 is
-- known to be imported (i.e. whose declaration specifies the Import
-- aspect). Note that for objects with a pragma Import, we generate
-- initialization here, and then remove it downstream when processing
-- the pragma.
-- the pragma. It is also suppressed for variables for which a pragma
-- Suppress_Initialization has been explicitly given
if Is_Imported (Def_Id) then
if Is_Imported (Def_Id) or else Suppress_Initialization (Def_Id) then
return;
end if;

360
gcc/ada/exp_pakd.adb
View File

@ -34,7 +34,6 @@ with Namet; use Namet;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch3; use Sem_Ch3;
@ -77,365 +76,6 @@ package body Exp_Pakd is
-- right rotate into a left rotate, avoiding the subtract, if the machine
-- architecture provides such an instruction.
----------------------------------------------
-- Entity Tables for Packed Access Routines --
----------------------------------------------
-- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
-- routines. This table provides the entity for the proper routine.
type E_Array is array (Int range 01 .. 63) of RE_Id;
-- Array of Bits_nn entities. Note that we do not use library routines
-- for the 8-bit and 16-bit cases, but we still fill in the table, using
-- entries from System.Unsigned, because we also use this table for
-- certain special unchecked conversions in the big-endian case.
Bits_Id : constant E_Array :=
(01 => RE_Bits_1,
02 => RE_Bits_2,
03 => RE_Bits_03,
04 => RE_Bits_4,
05 => RE_Bits_05,
06 => RE_Bits_06,
07 => RE_Bits_07,
08 => RE_Unsigned_8,
09 => RE_Bits_09,
10 => RE_Bits_10,
11 => RE_Bits_11,
12 => RE_Bits_12,
13 => RE_Bits_13,
14 => RE_Bits_14,
15 => RE_Bits_15,
16 => RE_Unsigned_16,
17 => RE_Bits_17,
18 => RE_Bits_18,
19 => RE_Bits_19,
20 => RE_Bits_20,
21 => RE_Bits_21,
22 => RE_Bits_22,
23 => RE_Bits_23,
24 => RE_Bits_24,
25 => RE_Bits_25,
26 => RE_Bits_26,
27 => RE_Bits_27,
28 => RE_Bits_28,
29 => RE_Bits_29,
30 => RE_Bits_30,
31 => RE_Bits_31,
32 => RE_Unsigned_32,
33 => RE_Bits_33,
34 => RE_Bits_34,
35 => RE_Bits_35,
36 => RE_Bits_36,
37 => RE_Bits_37,
38 => RE_Bits_38,
39 => RE_Bits_39,
40 => RE_Bits_40,
41 => RE_Bits_41,
42 => RE_Bits_42,
43 => RE_Bits_43,
44 => RE_Bits_44,
45 => RE_Bits_45,
46 => RE_Bits_46,
47 => RE_Bits_47,
48 => RE_Bits_48,
49 => RE_Bits_49,
50 => RE_Bits_50,
51 => RE_Bits_51,
52 => RE_Bits_52,
53 => RE_Bits_53,
54 => RE_Bits_54,
55 => RE_Bits_55,
56 => RE_Bits_56,
57 => RE_Bits_57,
58 => RE_Bits_58,
59 => RE_Bits_59,
60 => RE_Bits_60,
61 => RE_Bits_61,
62 => RE_Bits_62,
63 => RE_Bits_63);
-- Array of Get routine entities. These are used to obtain an element from
-- a packed array. The N'th entry is used to obtain elements from a packed
-- array whose component size is N. RE_Null is used as a null entry, for
-- the cases where a library routine is not used.
Get_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Get_03,
04 => RE_Null,
05 => RE_Get_05,
06 => RE_Get_06,
07 => RE_Get_07,
08 => RE_Null,
09 => RE_Get_09,
10 => RE_Get_10,
11 => RE_Get_11,
12 => RE_Get_12,
13 => RE_Get_13,
14 => RE_Get_14,
15 => RE_Get_15,
16 => RE_Null,
17 => RE_Get_17,
18 => RE_Get_18,
19 => RE_Get_19,
20 => RE_Get_20,
21 => RE_Get_21,
22 => RE_Get_22,
23 => RE_Get_23,
24 => RE_Get_24,
25 => RE_Get_25,
26 => RE_Get_26,
27 => RE_Get_27,
28 => RE_Get_28,
29 => RE_Get_29,
30 => RE_Get_30,
31 => RE_Get_31,
32 => RE_Null,
33 => RE_Get_33,
34 => RE_Get_34,
35 => RE_Get_35,
36 => RE_Get_36,
37 => RE_Get_37,
38 => RE_Get_38,
39 => RE_Get_39,
40 => RE_Get_40,
41 => RE_Get_41,
42 => RE_Get_42,
43 => RE_Get_43,
44 => RE_Get_44,
45 => RE_Get_45,
46 => RE_Get_46,
47 => RE_Get_47,
48 => RE_Get_48,
49 => RE_Get_49,
50 => RE_Get_50,
51 => RE_Get_51,
52 => RE_Get_52,
53 => RE_Get_53,
54 => RE_Get_54,
55 => RE_Get_55,
56 => RE_Get_56,
57 => RE_Get_57,
58 => RE_Get_58,
59 => RE_Get_59,
60 => RE_Get_60,
61 => RE_Get_61,
62 => RE_Get_62,
63 => RE_Get_63);
-- Array of Get routine entities to be used in the case where the packed
-- array is itself a component of a packed structure, and therefore may not
-- be fully aligned. This only affects the even sizes, since for the odd
-- sizes, we do not get any fixed alignment in any case.
GetU_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Get_03,
04 => RE_Null,
05 => RE_Get_05,
06 => RE_GetU_06,
07 => RE_Get_07,
08 => RE_Null,
09 => RE_Get_09,
10 => RE_GetU_10,
11 => RE_Get_11,
12 => RE_GetU_12,
13 => RE_Get_13,
14 => RE_GetU_14,
15 => RE_Get_15,
16 => RE_Null,
17 => RE_Get_17,
18 => RE_GetU_18,
19 => RE_Get_19,
20 => RE_GetU_20,
21 => RE_Get_21,
22 => RE_GetU_22,
23 => RE_Get_23,
24 => RE_GetU_24,
25 => RE_Get_25,
26 => RE_GetU_26,
27 => RE_Get_27,
28 => RE_GetU_28,
29 => RE_Get_29,
30 => RE_GetU_30,
31 => RE_Get_31,
32 => RE_Null,
33 => RE_Get_33,
34 => RE_GetU_34,
35 => RE_Get_35,
36 => RE_GetU_36,
37 => RE_Get_37,
38 => RE_GetU_38,
39 => RE_Get_39,
40 => RE_GetU_40,
41 => RE_Get_41,
42 => RE_GetU_42,
43 => RE_Get_43,
44 => RE_GetU_44,
45 => RE_Get_45,
46 => RE_GetU_46,
47 => RE_Get_47,
48 => RE_GetU_48,
49 => RE_Get_49,
50 => RE_GetU_50,
51 => RE_Get_51,
52 => RE_GetU_52,
53 => RE_Get_53,
54 => RE_GetU_54,
55 => RE_Get_55,
56 => RE_GetU_56,
57 => RE_Get_57,
58 => RE_GetU_58,
59 => RE_Get_59,
60 => RE_GetU_60,
61 => RE_Get_61,
62 => RE_GetU_62,
63 => RE_Get_63);
-- Array of Set routine entities. These are used to assign an element of a
-- packed array. The N'th entry is used to assign elements for a packed
-- array whose component size is N. RE_Null is used as a null entry, for
-- the cases where a library routine is not used.
Set_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Set_03,
04 => RE_Null,
05 => RE_Set_05,
06 => RE_Set_06,
07 => RE_Set_07,
08 => RE_Null,
09 => RE_Set_09,
10 => RE_Set_10,
11 => RE_Set_11,
12 => RE_Set_12,
13 => RE_Set_13,
14 => RE_Set_14,
15 => RE_Set_15,
16 => RE_Null,
17 => RE_Set_17,
18 => RE_Set_18,
19 => RE_Set_19,
20 => RE_Set_20,
21 => RE_Set_21,
22 => RE_Set_22,
23 => RE_Set_23,
24 => RE_Set_24,
25 => RE_Set_25,
26 => RE_Set_26,
27 => RE_Set_27,
28 => RE_Set_28,
29 => RE_Set_29,
30 => RE_Set_30,
31 => RE_Set_31,
32 => RE_Null,
33 => RE_Set_33,
34 => RE_Set_34,
35 => RE_Set_35,
36 => RE_Set_36,
37 => RE_Set_37,
38 => RE_Set_38,
39 => RE_Set_39,
40 => RE_Set_40,
41 => RE_Set_41,
42 => RE_Set_42,
43 => RE_Set_43,
44 => RE_Set_44,
45 => RE_Set_45,
46 => RE_Set_46,
47 => RE_Set_47,
48 => RE_Set_48,
49 => RE_Set_49,
50 => RE_Set_50,
51 => RE_Set_51,
52 => RE_Set_52,
53 => RE_Set_53,
54 => RE_Set_54,
55 => RE_Set_55,
56 => RE_Set_56,
57 => RE_Set_57,
58 => RE_Set_58,
59 => RE_Set_59,
60 => RE_Set_60,
61 => RE_Set_61,
62 => RE_Set_62,
63 => RE_Set_63);
-- Array of Set routine entities to be used in the case where the packed
-- array is itself a component of a packed structure, and therefore may not
-- be fully aligned. This only affects the even sizes, since for the odd
-- sizes, we do not get any fixed alignment in any case.
SetU_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Set_03,
04 => RE_Null,
05 => RE_Set_05,
06 => RE_SetU_06,
07 => RE_Set_07,
08 => RE_Null,
09 => RE_Set_09,
10 => RE_SetU_10,
11 => RE_Set_11,
12 => RE_SetU_12,
13 => RE_Set_13,
14 => RE_SetU_14,
15 => RE_Set_15,
16 => RE_Null,
17 => RE_Set_17,
18 => RE_SetU_18,
19 => RE_Set_19,
20 => RE_SetU_20,
21 => RE_Set_21,
22 => RE_SetU_22,
23 => RE_Set_23,
24 => RE_SetU_24,
25 => RE_Set_25,
26 => RE_SetU_26,
27 => RE_Set_27,
28 => RE_SetU_28,
29 => RE_Set_29,
30 => RE_SetU_30,
31 => RE_Set_31,
32 => RE_Null,
33 => RE_Set_33,
34 => RE_SetU_34,
35 => RE_Set_35,
36 => RE_SetU_36,
37 => RE_Set_37,
38 => RE_SetU_38,
39 => RE_Set_39,
40 => RE_SetU_40,
41 => RE_Set_41,
42 => RE_SetU_42,
43 => RE_Set_43,
44 => RE_SetU_44,
45 => RE_Set_45,
46 => RE_SetU_46,
47 => RE_Set_47,
48 => RE_SetU_48,
49 => RE_Set_49,
50 => RE_SetU_50,
51 => RE_Set_51,
52 => RE_SetU_52,
53 => RE_Set_53,
54 => RE_SetU_54,
55 => RE_Set_55,
56 => RE_SetU_56,
57 => RE_Set_57,
58 => RE_SetU_58,
59 => RE_Set_59,
60 => RE_SetU_60,
61 => RE_Set_61,
62 => RE_SetU_62,
63 => RE_Set_63);
-----------------------
-- Local Subprograms --
-----------------------

364
gcc/ada/exp_pakd.ads
View File

@ -25,7 +25,8 @@
-- Expand routines for manipulation of packed arrays
with Types; use Types;
with Rtsfind; use Rtsfind;
with Types; use Types;
package Exp_Pakd is
@ -203,6 +204,367 @@ package Exp_Pakd is
-- and now, we do indeed have the same representation for the memory
-- version in the constrained and unconstrained cases.
----------------------------------------------
-- Entity Tables for Packed Access Routines --
----------------------------------------------
-- For the cases of component size = 3,5-7,9-15,17-31,33-63 we call library
-- routines. These tables provide the entity for the proper routine. They
-- are exposed in the spec to allow checking for the presence of the needed
-- routine when an array is subject to pragma Pack.
type E_Array is array (Int range 01 .. 63) of RE_Id;
-- Array of Bits_nn entities. Note that we do not use library routines
-- for the 8-bit and 16-bit cases, but we still fill in the table, using
-- entries from System.Unsigned, because we also use this table for
-- certain special unchecked conversions in the big-endian case.
Bits_Id : constant E_Array :=
(01 => RE_Bits_1,
02 => RE_Bits_2,
03 => RE_Bits_03,
04 => RE_Bits_4,
05 => RE_Bits_05,
06 => RE_Bits_06,
07 => RE_Bits_07,
08 => RE_Unsigned_8,
09 => RE_Bits_09,
10 => RE_Bits_10,
11 => RE_Bits_11,
12 => RE_Bits_12,
13 => RE_Bits_13,
14 => RE_Bits_14,
15 => RE_Bits_15,
16 => RE_Unsigned_16,
17 => RE_Bits_17,
18 => RE_Bits_18,
19 => RE_Bits_19,
20 => RE_Bits_20,
21 => RE_Bits_21,
22 => RE_Bits_22,
23 => RE_Bits_23,
24 => RE_Bits_24,
25 => RE_Bits_25,
26 => RE_Bits_26,
27 => RE_Bits_27,
28 => RE_Bits_28,
29 => RE_Bits_29,
30 => RE_Bits_30,
31 => RE_Bits_31,
32 => RE_Unsigned_32,
33 => RE_Bits_33,
34 => RE_Bits_34,
35 => RE_Bits_35,
36 => RE_Bits_36,
37 => RE_Bits_37,
38 => RE_Bits_38,
39 => RE_Bits_39,
40 => RE_Bits_40,
41 => RE_Bits_41,
42 => RE_Bits_42,
43 => RE_Bits_43,
44 => RE_Bits_44,
45 => RE_Bits_45,
46 => RE_Bits_46,
47 => RE_Bits_47,
48 => RE_Bits_48,
49 => RE_Bits_49,
50 => RE_Bits_50,
51 => RE_Bits_51,
52 => RE_Bits_52,
53 => RE_Bits_53,
54 => RE_Bits_54,
55 => RE_Bits_55,
56 => RE_Bits_56,
57 => RE_Bits_57,
58 => RE_Bits_58,
59 => RE_Bits_59,
60 => RE_Bits_60,
61 => RE_Bits_61,
62 => RE_Bits_62,
63 => RE_Bits_63);
-- Array of Get routine entities. These are used to obtain an element from
-- a packed array. The N'th entry is used to obtain elements from a packed
-- array whose component size is N. RE_Null is used as a null entry, for
-- the cases where a library routine is not used.
Get_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Get_03,
04 => RE_Null,
05 => RE_Get_05,
06 => RE_Get_06,
07 => RE_Get_07,
08 => RE_Null,
09 => RE_Get_09,
10 => RE_Get_10,
11 => RE_Get_11,
12 => RE_Get_12,
13 => RE_Get_13,
14 => RE_Get_14,
15 => RE_Get_15,
16 => RE_Null,
17 => RE_Get_17,
18 => RE_Get_18,
19 => RE_Get_19,
20 => RE_Get_20,
21 => RE_Get_21,
22 => RE_Get_22,
23 => RE_Get_23,
24 => RE_Get_24,
25 => RE_Get_25,
26 => RE_Get_26,
27 => RE_Get_27,
28 => RE_Get_28,
29 => RE_Get_29,
30 => RE_Get_30,
31 => RE_Get_31,
32 => RE_Null,
33 => RE_Get_33,
34 => RE_Get_34,
35 => RE_Get_35,
36 => RE_Get_36,
37 => RE_Get_37,
38 => RE_Get_38,
39 => RE_Get_39,
40 => RE_Get_40,
41 => RE_Get_41,
42 => RE_Get_42,
43 => RE_Get_43,
44 => RE_Get_44,
45 => RE_Get_45,
46 => RE_Get_46,
47 => RE_Get_47,
48 => RE_Get_48,
49 => RE_Get_49,
50 => RE_Get_50,
51 => RE_Get_51,
52 => RE_Get_52,
53 => RE_Get_53,
54 => RE_Get_54,
55 => RE_Get_55,
56 => RE_Get_56,
57 => RE_Get_57,
58 => RE_Get_58,
59 => RE_Get_59,
60 => RE_Get_60,
61 => RE_Get_61,
62 => RE_Get_62,
63 => RE_Get_63);
-- Array of Get routine entities to be used in the case where the packed
-- array is itself a component of a packed structure, and therefore may not
-- be fully aligned. This only affects the even sizes, since for the odd
-- sizes, we do not get any fixed alignment in any case.
GetU_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Get_03,
04 => RE_Null,
05 => RE_Get_05,
06 => RE_GetU_06,
07 => RE_Get_07,
08 => RE_Null,
09 => RE_Get_09,
10 => RE_GetU_10,
11 => RE_Get_11,
12 => RE_GetU_12,
13 => RE_Get_13,
14 => RE_GetU_14,
15 => RE_Get_15,
16 => RE_Null,
17 => RE_Get_17,
18 => RE_GetU_18,
19 => RE_Get_19,
20 => RE_GetU_20,
21 => RE_Get_21,
22 => RE_GetU_22,
23 => RE_Get_23,
24 => RE_GetU_24,
25 => RE_Get_25,
26 => RE_GetU_26,
27 => RE_Get_27,
28 => RE_GetU_28,
29 => RE_Get_29,
30 => RE_GetU_30,
31 => RE_Get_31,
32 => RE_Null,
33 => RE_Get_33,
34 => RE_GetU_34,
35 => RE_Get_35,
36 => RE_GetU_36,
37 => RE_Get_37,
38 => RE_GetU_38,
39 => RE_Get_39,
40 => RE_GetU_40,
41 => RE_Get_41,
42 => RE_GetU_42,
43 => RE_Get_43,
44 => RE_GetU_44,
45 => RE_Get_45,
46 => RE_GetU_46,
47 => RE_Get_47,
48 => RE_GetU_48,
49 => RE_Get_49,
50 => RE_GetU_50,
51 => RE_Get_51,
52 => RE_GetU_52,
53 => RE_Get_53,
54 => RE_GetU_54,
55 => RE_Get_55,
56 => RE_GetU_56,
57 => RE_Get_57,
58 => RE_GetU_58,
59 => RE_Get_59,
60 => RE_GetU_60,
61 => RE_Get_61,
62 => RE_GetU_62,
63 => RE_Get_63);
-- Array of Set routine entities. These are used to assign an element of a
-- packed array. The N'th entry is used to assign elements for a packed
-- array whose component size is N. RE_Null is used as a null entry, for
-- the cases where a library routine is not used.
Set_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Set_03,
04 => RE_Null,
05 => RE_Set_05,
06 => RE_Set_06,
07 => RE_Set_07,
08 => RE_Null,
09 => RE_Set_09,
10 => RE_Set_10,
11 => RE_Set_11,
12 => RE_Set_12,
13 => RE_Set_13,
14 => RE_Set_14,
15 => RE_Set_15,
16 => RE_Null,
17 => RE_Set_17,
18 => RE_Set_18,
19 => RE_Set_19,
20 => RE_Set_20,
21 => RE_Set_21,
22 => RE_Set_22,
23 => RE_Set_23,
24 => RE_Set_24,
25 => RE_Set_25,
26 => RE_Set_26,
27 => RE_Set_27,
28 => RE_Set_28,
29 => RE_Set_29,
30 => RE_Set_30,
31 => RE_Set_31,
32 => RE_Null,
33 => RE_Set_33,
34 => RE_Set_34,
35 => RE_Set_35,
36 => RE_Set_36,
37 => RE_Set_37,
38 => RE_Set_38,
39 => RE_Set_39,
40 => RE_Set_40,
41 => RE_Set_41,
42 => RE_Set_42,
43 => RE_Set_43,
44 => RE_Set_44,
45 => RE_Set_45,
46 => RE_Set_46,
47 => RE_Set_47,
48 => RE_Set_48,
49 => RE_Set_49,
50 => RE_Set_50,
51 => RE_Set_51,
52 => RE_Set_52,
53 => RE_Set_53,
54 => RE_Set_54,
55 => RE_Set_55,
56 => RE_Set_56,
57 => RE_Set_57,
58 => RE_Set_58,
59 => RE_Set_59,
60 => RE_Set_60,
61 => RE_Set_61,
62 => RE_Set_62,
63 => RE_Set_63);
-- Array of Set routine entities to be used in the case where the packed
-- array is itself a component of a packed structure, and therefore may not
-- be fully aligned. This only affects the even sizes, since for the odd
-- sizes, we do not get any fixed alignment in any case.
SetU_Id : constant E_Array :=
(01 => RE_Null,
02 => RE_Null,
03 => RE_Set_03,
04 => RE_Null,
05 => RE_Set_05,
06 => RE_SetU_06,
07 => RE_Set_07,
08 => RE_Null,
09 => RE_Set_09,
10 => RE_SetU_10,
11 => RE_Set_11,
12 => RE_SetU_12,
13 => RE_Set_13,
14 => RE_SetU_14,
15 => RE_Set_15,
16 => RE_Null,
17 => RE_Set_17,
18 => RE_SetU_18,
19 => RE_Set_19,
20 => RE_SetU_20,
21 => RE_Set_21,
22 => RE_SetU_22,
23 => RE_Set_23,
24 => RE_SetU_24,
25 => RE_Set_25,
26 => RE_SetU_26,
27 => RE_Set_27,
28 => RE_SetU_28,
29 => RE_Set_29,
30 => RE_SetU_30,
31 => RE_Set_31,
32 => RE_Null,
33 => RE_Set_33,
34 => RE_SetU_34,
35 => RE_Set_35,
36 => RE_SetU_36,
37 => RE_Set_37,
38 => RE_SetU_38,
39 => RE_Set_39,
40 => RE_SetU_40,
41 => RE_Set_41,
42 => RE_SetU_42,
43 => RE_Set_43,
44 => RE_SetU_44,
45 => RE_Set_45,
46 => RE_SetU_46,
47 => RE_Set_47,
48 => RE_SetU_48,
49 => RE_Set_49,
50 => RE_SetU_50,
51 => RE_Set_51,
52 => RE_SetU_52,
53 => RE_Set_53,
54 => RE_SetU_54,
55 => RE_Set_55,
56 => RE_SetU_56,
57 => RE_Set_57,
58 => RE_SetU_58,
59 => RE_Set_59,
60 => RE_SetU_60,
61 => RE_Set_61,
62 => RE_SetU_62,
63 => RE_Set_63);
-----------------
-- Subprograms --
-----------------

90
gcc/ada/exp_prag.adb
View File

@ -71,6 +71,14 @@ package body Exp_Prag is
procedure Expand_Pragma_Loop_Variant (N : Node_Id);
procedure Expand_Pragma_Psect_Object (N : Node_Id);
procedure Expand_Pragma_Relative_Deadline (N : Node_Id);
procedure Expand_Pragma_Suppress_Initialization (N : Node_Id);
procedure Undo_Initialization (Def_Id : Entity_Id; N : Node_Id);
-- This procedure is used to undo initialization already done for Def_Id,
-- which is always an E_Variable, in response to the occurrence of the
-- pragma N, a pragma Interface, Import, or Suppress_Initialization. In all
-- these cases we want no initialization to occur, but we have already done
-- the initialization by the time we see the pragma, so we have to undo it.
----------
-- Arg1 --
@ -836,6 +844,9 @@ package body Exp_Prag is
when Pragma_Relative_Deadline =>
Expand_Pragma_Relative_Deadline (N);
when Pragma_Suppress_Initialization =>
Expand_Pragma_Suppress_Initialization (N);
-- All other pragmas need no expander action
when others => null;
@ -1170,7 +1181,6 @@ package body Exp_Prag is
procedure Expand_Pragma_Import_Or_Interface (N : Node_Id) is
Def_Id : Entity_Id;
Init_Call : Node_Id;
begin
-- In Relaxed_RM_Semantics, support old Ada 83 style:
@ -1186,35 +1196,10 @@ package body Exp_Prag is
Def_Id := Entity (Arg2 (N));
end if;
-- Variable case
-- Variable case (we have to undo any initialization already done)
if Ekind (Def_Id) = E_Variable then
-- When applied to a variable, the default initialization must not be
-- done. As it is already done when the pragma is found, we just get
-- rid of the call the initialization procedure which followed the
-- object declaration. The call is inserted after the declaration,
-- but validity checks may also have been inserted and thus the
-- initialization call does not necessarily appear immediately
-- after the object declaration.
-- We can't use the freezing mechanism for this purpose, since we
-- have to elaborate the initialization expression when it is first
-- seen (so this elaboration cannot be deferred to the freeze point).
-- Find and remove generated initialization call for object, if any
Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
-- Any default initialization expression should be removed (e.g.
-- null defaults for access objects, zero initialization of packed
-- bit arrays). Imported objects aren't allowed to have explicit
-- initialization, so the expression must have been generated by
-- the compiler.
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);
end if;
Undo_Initialization (Def_Id, N);
-- Case of exception with convention C++
@ -1831,4 +1816,53 @@ package body Exp_Prag is
end if;
end Expand_Pragma_Relative_Deadline;
-------------------------------------------
-- Expand_Pragma_Suppress_Initialization --
-------------------------------------------
procedure Expand_Pragma_Suppress_Initialization (N : Node_Id) is
Def_Id : constant Entity_Id := Entity (Arg1 (N));
begin
-- Variable case (we have to undo any initialization already done)
if Ekind (Def_Id) = E_Variable then
Undo_Initialization (Def_Id, N);
end if;
end Expand_Pragma_Suppress_Initialization;
-------------------------
-- Undo_Initialization --
-------------------------
procedure Undo_Initialization (Def_Id : Entity_Id; N : Node_Id) is
Init_Call : Node_Id;
begin
-- When applied to a variable, the default initialization must not be
-- done. As it is already done when the pragma is found, we just get rid
-- of the call the initialization procedure which followed the object
-- declaration. The call is inserted after the declaration, but validity
-- checks may also have been inserted and thus the initialization call
-- does not necessarily appear immediately after the object declaration.
-- We can't use the freezing mechanism for this purpose, since we have
-- to elaborate the initialization expression when it is first seen (so
-- this elaboration cannot be deferred to the freeze point).
-- Find and remove generated initialization call for object, if any
Init_Call := Remove_Init_Call (Def_Id, Rep_Clause => N);
-- Any default initialization expression should be removed (e.g.
-- null defaults for access objects, zero initialization of packed
-- bit arrays). Imported objects aren't allowed to have explicit
-- initialization, so the expression must have been generated by
-- the compiler.
if No (Init_Call) and then Present (Expression (Parent (Def_Id))) then
Set_Expression (Parent (Def_Id), Empty);
end if;
end Undo_Initialization;
end Exp_Prag;

18
gcc/ada/freeze.adb
View File

@ -2370,6 +2370,24 @@ package body Freeze is
Set_Has_Non_Standard_Rep (Base_Type (Arr), True);
Set_Is_Bit_Packed_Array (Base_Type (Arr), True);
Set_Is_Packed (Base_Type (Arr), True);
-- Make sure that we have the necessary routines to
-- implement the packing, and complain now if not.
declare
CS : constant Int := UI_To_Int (Csiz);
RE : constant RE_Id := Get_Id (CS);
begin
if RE /= RE_Null
and then not RTE_Available (RE)
then
Error_Msg_CRT
("packing of " & UI_Image (Csiz)
& "-bit components",
First_Subtype (Etype (Arr)));
end if;
end;
end if;
end;
end if;

23
gcc/ada/gnat_rm.texi
View File

@ -330,6 +330,7 @@ Implementation Defined Aspects
* Aspect Simple_Storage_Pool_Type::
* Aspect SPARK_Mode::
* Aspect Suppress_Debug_Info::
* Aspect Suppress_Initialization::
* Aspect Test_Case::
* Aspect Thread_Local_Storage::
* Aspect Universal_Aliasing::
@ -7029,13 +7030,16 @@ with this pragma and others compiled in normal mode without it.
Syntax:
@smallexample @c ada
pragma Suppress_Initialization ([Entity =>] subtype_Name);
pragma Suppress_Initialization ([Entity =>] variable_or_subtype_Name);
@end smallexample
@noindent
Here subtype_Name is the name introduced by a type declaration
or subtype declaration.
This pragma suppresses any implicit or explicit initialization
Here variable_or_subtype_Name is the name introduced by a type declaration
or subtype declaration or the name of a variable introduced by an
object declaration.
In the case of a type or subtype
this pragma suppresses any implicit or explicit initialization
for all variables of the given type or subtype,
including initialization resulting from the use of pragmas
Normalize_Scalars or Initialize_Scalars.
@ -7055,6 +7059,10 @@ you will have to use some non-portable mechanism (e.g. address
overlays or unchecked conversion) to achieve required initialization
of these fields before accessing any object of the corresponding type.
For the variable case, implicit initialization for the named variable
is suppressed, just as though its subtype had been given in a pragma
Suppress_Initialization, as described above.
@node Pragma Task_Name
@unnumberedsec Pragma Task_Name
@findex Task_Name
@ -8119,6 +8127,7 @@ or attribute definition clause.
* Aspect Simple_Storage_Pool_Type::
* Aspect SPARK_Mode::
* Aspect Suppress_Debug_Info::
* Aspect Suppress_Initialization::
* Aspect Test_Case::
* Aspect Thread_Local_Storage::
* Aspect Universal_Aliasing::
@ -8494,6 +8503,12 @@ of a subprogram or package.
@noindent
This boolean aspect is equivalent to pragma @code{Suppress_Debug_Info}.
@node Aspect Suppress_Initialization
@unnumberedsec Aspect Suppress_Initialization
@findex Suppress_Initialization
@noindent
This boolean aspect is equivalent to pragma @code{Suppress_Initialization}.
@node Aspect Test_Case
@unnumberedsec Aspect Test_Case
@findex Test_Case

108
gcc/ada/rtsfind.adb
View File

@ -128,6 +128,60 @@ package body Rtsfind is
-- The field First_Implicit_With in the unit table record are used to
-- avoid creating duplicate with_clauses.
----------------------------------------------
-- Table of Predefined RE_Id Error Messages --
----------------------------------------------
-- If an attempt is made to load an entity, given an RE_Id value, and the
-- entity is not available in the current configuration, an error message
-- is given (see Entity_Not_Defined below). The general form of such an
-- error message is for example:
-- entity "System.Pack_43.Bits_43" not defined
-- The following table defines a set of RE_Id image values for which this
-- error message is specialized and replaced by specific text indicating
-- the exact message to be output. For example, in the case above, for the
-- RE_Id value RE_Bits_43, we do indeed specialize the message, and the
-- above generic message is replaced by:
-- packed component size of 43 is not supported
type CString_Ptr is access constant String;
type PRE_Id_Entry is record
Str : CString_Ptr;
-- Pointer to string with the RE_Id image. The sequence ?? may appear
-- in which case it will match any characters in the RE_Id image value.
-- This is used to avoid the need for dozens of entries for RE_Bits_??.
Msg : CString_Ptr;
-- Pointer to string with the corresponding error text. The sequence
-- ?? may appear, in which case, it is replaced by the corresponding
-- sequence ?? in the Str value (if the first ? is zero, then it is
-- omitted from the message).
end record;
Str1 : aliased constant String := "RE_BITS_??";
Str2 : aliased constant String := "RE_GET_??";
Str3 : aliased constant String := "RE_SET_??";
Str4 : aliased constant String := "RE_CALL_SIMPLE";
MsgPack : aliased constant String :=
"packed component size of ?? is not supported";
MsgRV : aliased constant String :=
"task rendezvous is not supported";
PRE_Id_Table : constant array (Natural range <>) of PRE_Id_Entry :=
(1 => (Str1'Access, MsgPack'Access),
2 => (Str2'Access, MsgPack'Access),
3 => (Str3'Access, MsgPack'Access),
4 => (Str4'Access, MsgRV'Access));
-- We will add entries to this table as we find cases where it is a good
-- idea to do so. By no means all the RE_Id values need entries, because
-- the expander often gives clear messages before it makes the Rtsfind
-- call expecting to find the entity.
-----------------------
-- Local Subprograms --
-----------------------
@ -141,7 +195,8 @@ package body Rtsfind is
procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the run-time
-- library (the form of the error message is tailored for no run time or
-- configurable run time mode as required).
-- configurable run time mode as required). See also table of pre-defined
-- messages for entities above (RE_Id_Messages).
function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type;
-- Retrieves the Unit Name given a unit id represented by its enumeration
@ -191,8 +246,7 @@ package body Rtsfind is
procedure Output_Entity_Name (Id : RE_Id; Msg : String);
-- Output continuation error message giving qualified name of entity
-- corresponding to Id, appending the string given by Msg. This call
-- is only effective in All_Errors mode.
-- corresponding to Id, appending the string given by Msg.
function RE_Chars (E : RE_Id) return Name_Id;
-- Given a RE_Id value returns the Chars of the corresponding entity
@ -432,6 +486,54 @@ package body Rtsfind is
RTE_Error_Msg ("run-time configuration error");
end if;
-- See if this entry is to be found in the PRE_Id table that provides
-- specialized messages for some RE_Id values.
for J in PRE_Id_Table'Range loop
declare
TStr : constant String := PRE_Id_Table (J).Str.all;
RStr : constant String := RE_Id'Image (Id);
TMsg : String := PRE_Id_Table (J).Msg.all;
LMsg : Natural := TMsg'Length;
begin
if TStr'Length = RStr'Length then
for J in TStr'Range loop
if TStr (J) /= RStr (J) and then TStr (J) /= '?' then
goto Continue;
end if;
end loop;
for J in TMsg'First .. TMsg'Last - 1 loop
if TMsg (J) = '?' then
for K in 1 .. TStr'Last loop
if TStr (K) = '?' then
if RStr (K) = '0' then
TMsg (J) := RStr (K + 1);
TMsg (J + 1 .. LMsg - 1) := TMsg (J + 2 .. LMsg);
LMsg := LMsg - 1;
else
TMsg (J .. J + 1) := RStr (K .. K + 1);
end if;
exit;
end if;
end loop;
end if;
end loop;
RTE_Error_Msg (TMsg (1 .. LMsg));
return;
end if;
end;
<<Continue>> null;
end loop;
-- We did not find an entry in the table, so output the generic entity
-- not found message, where the name of the entity corresponds to the
-- given RE_Id value.
Output_Entity_Name (Id, "not defined");
end Entity_Not_Defined;

6
gcc/ada/sem_attr.adb
View File

@ -7553,15 +7553,17 @@ package body Sem_Attr is
Static :=
Static and then not Is_Constr_Subt_For_U_Nominal (P_Type);
Set_Is_Static_Expression (N, Static);
end if;
while Present (Nod) loop
if not Is_Static_Subtype (Etype (Nod)) then
Static := False;
Set_Is_Static_Expression (N, False);
elsif not Is_OK_Static_Subtype (Etype (Nod)) then
Set_Raises_Constraint_Error (N);
Static := False;
Set_Is_Static_Expression (N, False);
end if;
-- If however the index type is generic, or derived from
@ -7591,6 +7593,7 @@ package body Sem_Attr is
begin
E := E1;
while Present (E) loop
-- If expression is not static, then the attribute reference
@ -7638,6 +7641,7 @@ package body Sem_Attr is
end loop;
if Raises_Constraint_Error (Prefix (N)) then
Set_Is_Static_Expression (N, False);
return;
end if;
end;

7
gcc/ada/sem_prag.adb
View File

@ -19927,8 +19927,9 @@ package body Sem_Prag is
E := Entity (E_Id);
if not Is_Type (E) then
Error_Pragma_Arg ("pragma% requires type or subtype", Arg1);
if not Is_Type (E) and then Ekind (E) /= E_Variable then
Error_Pragma_Arg
("pragma% requires variable, type or subtype", Arg1);
end if;
if Rep_Item_Too_Early (E, N)
@ -19953,7 +19954,7 @@ package body Sem_Prag is
elsif Is_First_Subtype (E) then
Set_Suppress_Initialization (Base_Type (E));
-- For other than first subtype, set flag on subtype itself
-- For other than first subtype, set flag on subtype or variable
else
Set_Suppress_Initialization (E);

5
gcc/ada/sem_util.adb
View File

@ -16462,8 +16462,9 @@ package body Sem_Util is
-- the entities within it).
if (Is_Implementation_Defined (Val)
or else
Is_Implementation_Defined (Scope (Val)))
or else
(Present (Scope (Val))
and then Is_Implementation_Defined (Scope (Val))))
and then not (Ekind_In (Val, E_Package, E_Generic_Package)
and then Is_Library_Level_Entity (Val))
then

17
gcc/ada/spark_xrefs.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2011-2014, 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- --
@ -187,6 +187,21 @@ package SPARK_Xrefs is
-- Examples: ??? add examples here
-- -------------------------------
-- -- Generated Globals Section --
-- -------------------------------
-- The Generated Globals section is located at the end of the ALI file.
-- All lines introducing information related to the Generated Globals
-- have the string "GG" appearing in the beginning. This string ("GG")
-- should therefore not be used in the beginning of any line that does
-- not relate to Generated Globals.
-- The processing (reading and writing) of this section happens in
-- package Flow_Computed_Globals (from the SPARK 2014 sources), for
-- further information please refer there.
----------------
-- Xref Table --
----------------

11
gcc/ada/uintp.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -1662,6 +1662,15 @@ package body Uintp is
Image_Out (Input, True, Format);
end UI_Image;
function UI_Image
(Input : Uint;
Format : UI_Format := Auto) return String
is
begin
Image_Out (Input, True, Format);
return UI_Image_Buffer (1 .. UI_Image_Length);
end UI_Image;
-------------------------
-- UI_Is_In_Int_Range --
-------------------------

15
gcc/ada/uintp.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -299,10 +299,15 @@ package Uintp is
-- followed by the value in UI_Image_Buffer. The form of the value is an
-- integer literal in either decimal (no base) or hexadecimal (base 16)
-- format. If Hex is True on entry, then hex mode is forced, otherwise
-- UI_Image makes a guess at which output format is more convenient.
-- The value must fit in UI_Image_Buffer. If necessary, the result is an
-- approximation of the proper value, using an exponential format. The
-- image of No_Uint is output as a single question mark.
-- UI_Image makes a guess at which output format is more convenient. The
-- value must fit in UI_Image_Buffer. The actual length of the result is
-- returned in UI_Image_Length. If necessary to meet this requirement, the
-- result is an approximation of the proper value, using an exponential
-- format. The image of No_Uint is output as a single question mark.
function UI_Image (Input : Uint; Format : UI_Format := Auto) return String;
-- Functional form, in which the result is returned as a string. This call
-- also leaves the result in UI_Image_Buffer/Length as described above.
procedure UI_Write (Input : Uint; Format : UI_Format := Auto);
-- Writes a representation of Uint, consisting of a possible minus sign,