[multiple changes]

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* warnsw.adb: Minor fixes to -gnatw.d handling.

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* einfo.adb, atree.adb: Enlarge entities to make 63 more flags, 6 more
	fields.

2013-01-04  Joel Brobecker  <brobecker@adacore.com brobecker>

	* gnat_ugn.texi: Fix typo.

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document alignment choice for subtypes.

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* validsw.ads: Minor fix to comment.

2013-01-04  Doug Rupp  <rupp@adacore.com>

	* Makefile.rtl (GNATRTL_NONTASKING_OBJS,
	GNATRTL_ALTIVEC_OBJS): Factor g-al* objects.
	* gcc-interface/Makefile.in (ADA_EXCLUDE_SRCS): Add g-al* sources.
	(GNATRTL_ALTIVEC_OBJS): Override to null for VMS.
	Rename leon vxworks toolchain as leon-wrs-vxworks.
	* gcc-interface/Make-lang.in: Update dependencies

2013-01-04  Pascal Obry  <obry@adacore.com>

	* prj.ads (For_Each_Source): Add Locally_Removed parameter.
	(Source_Iterator): Add Locally_Removed field.
	* prj.adb (For_Each_Source): Ignore Locally_Removed files if needed.
	(Next): Likewise.

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb: Minor reformatting.

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Insert_Valid_Check): Fix handling of renamed
	packed array element.
	* exp_ch4.adb (Expand_Concatenate): Fix some missing parent
	fields in generated code.
	* exp_util.adb (Side_Effect_Free): Improve detection of cases
	needing renaming.

2013-01-04  Robert Dewar  <dewar@adacore.com>

	* sinfo.ads: Clean up order of N_xxx subtypes

2013-01-04  Vincent Celier  <celier@adacore.com>

	* prj-conf.adb (Check_Target): Allow --autoconf= with no target.

From-SVN: r194896
This commit is contained in:
Arnaud Charlet 2013-01-04 11:08:58 +01:00
parent 7fcd29e08c
commit 0e564ab485
17 changed files with 1785 additions and 183 deletions

View File

@ -1,3 +1,61 @@
2013-01-04 Robert Dewar <dewar@adacore.com>
* warnsw.adb: Minor fixes to -gnatw.d handling.
2013-01-04 Robert Dewar <dewar@adacore.com>
* einfo.adb, atree.adb: Enlarge entities to make 63 more flags, 6 more
fields.
2013-01-04 Joel Brobecker <brobecker@adacore.com brobecker>
* gnat_ugn.texi: Fix typo.
2013-01-04 Robert Dewar <dewar@adacore.com>
* gnat_rm.texi: Document alignment choice for subtypes.
2013-01-04 Robert Dewar <dewar@adacore.com>
* validsw.ads: Minor fix to comment.
2013-01-04 Doug Rupp <rupp@adacore.com>
* Makefile.rtl (GNATRTL_NONTASKING_OBJS,
GNATRTL_ALTIVEC_OBJS): Factor g-al* objects.
* gcc-interface/Makefile.in (ADA_EXCLUDE_SRCS): Add g-al* sources.
(GNATRTL_ALTIVEC_OBJS): Override to null for VMS.
Rename leon vxworks toolchain as leon-wrs-vxworks.
* gcc-interface/Make-lang.in: Update dependencies
2013-01-04 Pascal Obry <obry@adacore.com>
* prj.ads (For_Each_Source): Add Locally_Removed parameter.
(Source_Iterator): Add Locally_Removed field.
* prj.adb (For_Each_Source): Ignore Locally_Removed files if needed.
(Next): Likewise.
2013-01-04 Robert Dewar <dewar@adacore.com>
* exp_attr.adb: Minor reformatting.
2013-01-04 Robert Dewar <dewar@adacore.com>
* checks.adb (Insert_Valid_Check): Fix handling of renamed
packed array element.
* exp_ch4.adb (Expand_Concatenate): Fix some missing parent
fields in generated code.
* exp_util.adb (Side_Effect_Free): Improve detection of cases
needing renaming.
2013-01-04 Robert Dewar <dewar@adacore.com>
* sinfo.ads: Clean up order of N_xxx subtypes
2013-01-04 Vincent Celier <celier@adacore.com>
* prj-conf.adb (Check_Target): Allow --autoconf= with no target.
2013-01-04 Robert Dewar <dewar@adacore.com>
* types.ads, prj-conf.adb, par-tchk.adb: Minor reformatting.

View File

@ -79,6 +79,16 @@ GNATRTL_TASKING_OBJS= \
thread$(objext) \
$(EXTRA_GNATRTL_TASKING_OBJS)
# Objects the require IEEE Float
GNATRTL_ALTIVEC_OBJS= \
g-allein$(objext) \
g-alleve$(objext) \
g-altcon$(objext) \
g-altive$(objext) \
g-alveop$(objext) \
g-alvety$(objext) \
g-alvevi$(objext)
# Objects needed for non-tasking.
GNATRTL_NONTASKING_OBJS= \
a-assert$(objext) \
@ -367,13 +377,6 @@ GNATRTL_NONTASKING_OBJS= \
ada$(objext) \
calendar$(objext) \
directio$(objext) \
g-allein$(objext) \
g-alleve$(objext) \
g-altcon$(objext) \
g-altive$(objext) \
g-alveop$(objext) \
g-alvety$(objext) \
g-alvevi$(objext) \
g-arrspl$(objext) \
g-awk$(objext) \
g-bubsor$(objext) \
@ -703,5 +706,6 @@ GNATRTL_NONTASKING_OBJS= \
text_io$(objext) \
unchconv$(objext) \
unchdeal$(objext) \
$(GNATRTL_ALTIVEC_OBJS) \
$(GNATRTL_SOCKETS_OBJS) \
$(EXTRA_GNATRTL_NONTASKING_OBJS)

File diff suppressed because it is too large Load Diff

View File

@ -196,9 +196,9 @@ package Atree is
-- entity, it is of type Entity_Kind which is defined
-- in package Einfo.
-- Flag19 235 additional flags
-- Flag19 299 additional flags
-- ...
-- Flag254
-- Flag317
-- Convention Entity convention (Convention_Id value)
@ -208,9 +208,9 @@ package Atree is
-- Elist6 Synonym for Field6 typed as Elist_Id (Empty = No_Elist)
-- Uint6 Synonym for Field6 typed as Uint (Empty = Uint_0)
-- Similar definitions for Field7 to Field28 (and Node7-Node28,
-- Elist7-Elist28, Uint7-Uint28, Ureal7-Ureal28). Note that not all these
-- functions are defined, only the ones that are actually used.
-- Similar definitions for Field7 to Field35 (and also Node7-Node35,
-- Elist7-Elist35, Uint7-Uint35, Ureal7-Ureal35). Note that not all
-- these functions are defined, only the ones that are actually used.
function Last_Node_Id return Node_Id;
pragma Inline (Last_Node_Id);
@ -334,22 +334,22 @@ package Atree is
-- Field1-5 fields are set to Empty
-- Field6-29 fields in extended nodes are set to Empty
-- Field6-35 fields in extended nodes are set to Empty
-- Parent is set to Empty
-- All Boolean flag fields are set to False
-- Note: the value Empty is used in Field1-Field17 to indicate a null node.
-- The usage varies. The common uses are to indicate absence of an
-- optional clause or a completely unused Field1-17 field.
-- Note: the value Empty is used in Field1-Field35 to indicate a null node.
-- The usage varies. The common uses are to indicate absence of an optional
-- clause or a completely unused Field1-35 field.
-------------------------------------
-- Use of Synonyms for Node Fields --
-------------------------------------
-- A subpackage Atree.Unchecked_Access provides routines for reading and
-- writing the fields defined above (Field1-27, Node1-27, Flag4-254 etc).
-- writing the fields defined above (Field1-35, Node1-35, Flag4-317 etc).
-- These unchecked access routines can be used for untyped traversals.
-- In addition they are used in the implementations of the Sinfo and
-- Einfo packages. These packages both provide logical synonyms for
@ -481,10 +481,9 @@ package Atree is
-- valid. This routine is used in conjunction with the tree rewrite
-- routines (see descriptions of Replace/Rewrite).
--
-- Note that the resulting node has the same parent as the source
-- node, and is thus still attached to the tree. It is valid for
-- Source to be Empty, in which case Relocate_Node simply returns
-- Empty as the result.
-- Note that the resulting node has the same parent as the source node, and
-- is thus still attached to the tree. It is valid for Source to be Empty,
-- in which case Relocate_Node simply returns Empty as the result.
function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
-- Given a node that is the root of a subtree, Copy_Separate_Tree copies
@ -1063,6 +1062,24 @@ package Atree is
function Field29 (N : Node_Id) return Union_Id;
pragma Inline (Field29);
function Field30 (N : Node_Id) return Union_Id;
pragma Inline (Field30);
function Field31 (N : Node_Id) return Union_Id;
pragma Inline (Field31);
function Field32 (N : Node_Id) return Union_Id;
pragma Inline (Field32);
function Field33 (N : Node_Id) return Union_Id;
pragma Inline (Field33);
function Field34 (N : Node_Id) return Union_Id;
pragma Inline (Field34);
function Field35 (N : Node_Id) return Union_Id;
pragma Inline (Field35);
function Node1 (N : Node_Id) return Node_Id;
pragma Inline (Node1);
@ -2043,6 +2060,195 @@ package Atree is
function Flag254 (N : Node_Id) return Boolean;
pragma Inline (Flag254);
function Flag255 (N : Node_Id) return Boolean;
pragma Inline (Flag255);
function Flag256 (N : Node_Id) return Boolean;
pragma Inline (Flag256);
function Flag257 (N : Node_Id) return Boolean;
pragma Inline (Flag257);
function Flag258 (N : Node_Id) return Boolean;
pragma Inline (Flag258);
function Flag259 (N : Node_Id) return Boolean;
pragma Inline (Flag259);
function Flag260 (N : Node_Id) return Boolean;
pragma Inline (Flag260);
function Flag261 (N : Node_Id) return Boolean;
pragma Inline (Flag261);
function Flag262 (N : Node_Id) return Boolean;
pragma Inline (Flag262);
function Flag263 (N : Node_Id) return Boolean;
pragma Inline (Flag263);
function Flag264 (N : Node_Id) return Boolean;
pragma Inline (Flag264);
function Flag265 (N : Node_Id) return Boolean;
pragma Inline (Flag265);
function Flag266 (N : Node_Id) return Boolean;
pragma Inline (Flag266);
function Flag267 (N : Node_Id) return Boolean;
pragma Inline (Flag267);
function Flag268 (N : Node_Id) return Boolean;
pragma Inline (Flag268);
function Flag269 (N : Node_Id) return Boolean;
pragma Inline (Flag269);
function Flag270 (N : Node_Id) return Boolean;
pragma Inline (Flag270);
function Flag271 (N : Node_Id) return Boolean;
pragma Inline (Flag271);
function Flag272 (N : Node_Id) return Boolean;
pragma Inline (Flag272);
function Flag273 (N : Node_Id) return Boolean;
pragma Inline (Flag273);
function Flag274 (N : Node_Id) return Boolean;
pragma Inline (Flag274);
function Flag275 (N : Node_Id) return Boolean;
pragma Inline (Flag275);
function Flag276 (N : Node_Id) return Boolean;
pragma Inline (Flag276);
function Flag277 (N : Node_Id) return Boolean;
pragma Inline (Flag277);
function Flag278 (N : Node_Id) return Boolean;
pragma Inline (Flag278);
function Flag279 (N : Node_Id) return Boolean;
pragma Inline (Flag279);
function Flag280 (N : Node_Id) return Boolean;
pragma Inline (Flag280);
function Flag281 (N : Node_Id) return Boolean;
pragma Inline (Flag281);
function Flag282 (N : Node_Id) return Boolean;
pragma Inline (Flag282);
function Flag283 (N : Node_Id) return Boolean;
pragma Inline (Flag283);
function Flag284 (N : Node_Id) return Boolean;
pragma Inline (Flag284);
function Flag285 (N : Node_Id) return Boolean;
pragma Inline (Flag285);
function Flag286 (N : Node_Id) return Boolean;
pragma Inline (Flag286);
function Flag287 (N : Node_Id) return Boolean;
pragma Inline (Flag287);
function Flag288 (N : Node_Id) return Boolean;
pragma Inline (Flag288);
function Flag289 (N : Node_Id) return Boolean;
pragma Inline (Flag289);
function Flag290 (N : Node_Id) return Boolean;
pragma Inline (Flag290);
function Flag291 (N : Node_Id) return Boolean;
pragma Inline (Flag291);
function Flag292 (N : Node_Id) return Boolean;
pragma Inline (Flag292);
function Flag293 (N : Node_Id) return Boolean;
pragma Inline (Flag293);
function Flag294 (N : Node_Id) return Boolean;
pragma Inline (Flag294);
function Flag295 (N : Node_Id) return Boolean;
pragma Inline (Flag295);
function Flag296 (N : Node_Id) return Boolean;
pragma Inline (Flag296);
function Flag297 (N : Node_Id) return Boolean;
pragma Inline (Flag297);
function Flag298 (N : Node_Id) return Boolean;
pragma Inline (Flag298);
function Flag299 (N : Node_Id) return Boolean;
pragma Inline (Flag299);
function Flag300 (N : Node_Id) return Boolean;
pragma Inline (Flag300);
function Flag301 (N : Node_Id) return Boolean;
pragma Inline (Flag301);
function Flag302 (N : Node_Id) return Boolean;
pragma Inline (Flag302);
function Flag303 (N : Node_Id) return Boolean;
pragma Inline (Flag303);
function Flag304 (N : Node_Id) return Boolean;
pragma Inline (Flag304);
function Flag305 (N : Node_Id) return Boolean;
pragma Inline (Flag305);
function Flag306 (N : Node_Id) return Boolean;
pragma Inline (Flag306);
function Flag307 (N : Node_Id) return Boolean;
pragma Inline (Flag307);
function Flag308 (N : Node_Id) return Boolean;
pragma Inline (Flag308);
function Flag309 (N : Node_Id) return Boolean;
pragma Inline (Flag309);
function Flag310 (N : Node_Id) return Boolean;
pragma Inline (Flag310);
function Flag311 (N : Node_Id) return Boolean;
pragma Inline (Flag311);
function Flag312 (N : Node_Id) return Boolean;
pragma Inline (Flag312);
function Flag313 (N : Node_Id) return Boolean;
pragma Inline (Flag313);
function Flag314 (N : Node_Id) return Boolean;
pragma Inline (Flag314);
function Flag315 (N : Node_Id) return Boolean;
pragma Inline (Flag315);
function Flag316 (N : Node_Id) return Boolean;
pragma Inline (Flag316);
function Flag317 (N : Node_Id) return Boolean;
pragma Inline (Flag317);
-- Procedures to set value of indicated field
procedure Set_Nkind (N : Node_Id; Val : Node_Kind);
@ -2135,6 +2341,24 @@ package Atree is
procedure Set_Field29 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field29);
procedure Set_Field30 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field30);
procedure Set_Field31 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field31);
procedure Set_Field32 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field32);
procedure Set_Field33 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field33);
procedure Set_Field34 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field34);
procedure Set_Field35 (N : Node_Id; Val : Union_Id);
pragma Inline (Set_Field35);
procedure Set_Node1 (N : Node_Id; Val : Node_Id);
pragma Inline (Set_Node1);
@ -3110,6 +3334,195 @@ package Atree is
procedure Set_Flag254 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag254);
procedure Set_Flag255 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag255);
procedure Set_Flag256 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag256);
procedure Set_Flag257 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag257);
procedure Set_Flag258 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag258);
procedure Set_Flag259 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag259);
procedure Set_Flag260 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag260);
procedure Set_Flag261 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag261);
procedure Set_Flag262 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag262);
procedure Set_Flag263 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag263);
procedure Set_Flag264 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag264);
procedure Set_Flag265 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag265);
procedure Set_Flag266 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag266);
procedure Set_Flag267 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag267);
procedure Set_Flag268 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag268);
procedure Set_Flag269 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag269);
procedure Set_Flag270 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag270);
procedure Set_Flag271 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag271);
procedure Set_Flag272 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag272);
procedure Set_Flag273 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag273);
procedure Set_Flag274 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag274);
procedure Set_Flag275 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag275);
procedure Set_Flag276 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag276);
procedure Set_Flag277 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag277);
procedure Set_Flag278 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag278);
procedure Set_Flag279 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag279);
procedure Set_Flag280 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag280);
procedure Set_Flag281 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag281);
procedure Set_Flag282 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag282);
procedure Set_Flag283 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag283);
procedure Set_Flag284 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag284);
procedure Set_Flag285 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag285);
procedure Set_Flag286 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag286);
procedure Set_Flag287 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag287);
procedure Set_Flag288 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag288);
procedure Set_Flag289 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag289);
procedure Set_Flag290 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag290);
procedure Set_Flag291 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag291);
procedure Set_Flag292 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag292);
procedure Set_Flag293 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag293);
procedure Set_Flag294 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag294);
procedure Set_Flag295 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag295);
procedure Set_Flag296 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag296);
procedure Set_Flag297 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag297);
procedure Set_Flag298 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag298);
procedure Set_Flag299 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag299);
procedure Set_Flag300 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag300);
procedure Set_Flag301 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag301);
procedure Set_Flag302 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag302);
procedure Set_Flag303 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag303);
procedure Set_Flag304 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag304);
procedure Set_Flag305 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag305);
procedure Set_Flag306 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag306);
procedure Set_Flag307 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag307);
procedure Set_Flag308 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag308);
procedure Set_Flag309 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag309);
procedure Set_Flag310 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag310);
procedure Set_Flag311 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag311);
procedure Set_Flag312 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag312);
procedure Set_Flag313 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag313);
procedure Set_Flag314 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag314);
procedure Set_Flag315 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag315);
procedure Set_Flag316 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag316);
procedure Set_Flag317 (N : Node_Id; Val : Boolean);
pragma Inline (Set_Flag317);
-- The following versions of Set_Noden also set the parent pointer of
-- the referenced node if it is not Empty.
@ -3226,32 +3639,32 @@ package Atree is
Flag18 : Boolean;
-- The eighteen flags for a normal node
-- The above fields are used as follows in components 2-5 of
-- The above fields are used as follows in components 2-6 of
-- an extended node entry.
-- In_List used as Flag19, Flag40, Flag129, Flag216
-- Has_Aspects used as Flag20, Flag41, Flag130, Flag217
-- Rewrite_Ins used as Flag21, Flag42, Flag131, Flag218
-- Analyzed used as Flag22, Flag43, Flag132, Flag219
-- Comes_From_Source used as Flag23, Flag44, Flag133, Flag220
-- Error_Posted used as Flag24, Flag45, Flag134, Flag221
-- Flag4 used as Flag25, Flag46, Flag135, Flag222
-- Flag5 used as Flag26, Flag47, Flag136, Flag223
-- Flag6 used as Flag27, Flag48, Flag137, Flag224
-- Flag7 used as Flag28, Flag49, Flag138, Flag225
-- Flag8 used as Flag29, Flag50, Flag139, Flag226
-- Flag9 used as Flag30, Flag51, Flag140, Flag227
-- Flag10 used as Flag31, Flag52, Flag141, Flag228
-- Flag11 used as Flag32, Flag53, Flag142, Flag229
-- Flag12 used as Flag33, Flag54, Flag143, Flag230
-- Flag13 used as Flag34, Flag55, Flag144, Flag231
-- Flag14 used as Flag35, Flag56, Flag145, Flag232
-- Flag15 used as Flag36, Flag57, Flag146, Flag233
-- Flag16 used as Flag37, Flag58, Flag147, Flag234
-- Flag17 used as Flag38, Flag59, Flag148, Flag235
-- Flag18 used as Flag39, Flag60, Flag149, Flag236
-- Pflag1 used as Flag61, Flag62, Flag150, Flag237
-- Pflag2 used as Flag63, Flag64, Flag151, Flag238
-- In_List used as Flag19,Flag40,Flag129,Flag216,Flag287
-- Has_Aspects used as Flag20,Flag41,Flag130,Flag217,Flag288
-- Rewrite_Ins used as Flag21,Flag42,Flag131,Flag218,Flag289
-- Analyzed used as Flag22,Flag43,Flag132,Flag219,Flag290
-- Comes_From_Source used as Flag23,Flag44,Flag133,Flag220,Flag291
-- Error_Posted used as Flag24,Flag45,Flag134,Flag221,Flag292
-- Flag4 used as Flag25,Flag46,Flag135,Flag222,Flag293
-- Flag5 used as Flag26,Flag47,Flag136,Flag223,Flag294
-- Flag6 used as Flag27,Flag48,Flag137,Flag224,Flag295
-- Flag7 used as Flag28,Flag49,Flag138,Flag225,Flag296
-- Flag8 used as Flag29,Flag50,Flag139,Flag226,Flag297
-- Flag9 used as Flag30,Flag51,Flag140,Flag227,Flag298
-- Flag10 used as Flag31,Flag52,Flag141,Flag228,Flag299
-- Flag11 used as Flag32,Flag53,Flag142,Flag229,Flag300
-- Flag12 used as Flag33,Flag54,Flag143,Flag230,Flag301
-- Flag13 used as Flag34,Flag55,Flag144,Flag231,Flag302
-- Flag14 used as Flag35,Flag56,Flag145,Flag232,Flag303
-- Flag15 used as Flag36,Flag57,Flag146,Flag233,Flag304
-- Flag16 used as Flag37,Flag58,Flag147,Flag234,Flag305
-- Flag17 used as Flag38,Flag59,Flag148,Flag235,Flag306
-- Flag18 used as Flag39,Flag60,Flag149,Flag236,Flag307
-- Pflag1 used as Flag61,Flag62,Flag150,Flag237,Flag308
-- Pflag2 used as Flag63,Flag64,Flag151,Flag238,Flag309
Nkind : Node_Kind;
-- For a non-extended node, or the initial section of an extended
@ -3262,6 +3675,7 @@ package Atree is
-- Third entry: holds 8 additional flags (Flag65-Flag72)
-- Fourth entry: holds 8 additional flags (Flag239-246)
-- Fifth entry: holds 8 additional flags (Flag247-254)
-- Sixth entry: holds 8 additional flags (Flag310-317)
-- Now finally (on an 32-bit boundary!) comes the variant part
@ -3327,6 +3741,13 @@ package Atree is
-- Field6-11 Holds Field24-Field29
-- Field12 Holds Flag184-Flag215
-- In the sixth component, the extension format as described
-- above is used to hold additional general fields and flags
-- as follows:
-- Field6-11 Holds Field30-Field35
-- Field12 Holds Flag255-Flag286
end case;
end record;
@ -3380,10 +3801,10 @@ package Atree is
Field5 => Empty_List_Or_Node);
-- Default value used to initialize node extensions (i.e. the second
-- and third and fourth components of an extended node). Note we are
-- cheating a bit here when it comes to Node12, which really holds
-- flags an (for the third component), the convention. But it works
-- because Empty, False, Convention_Ada, all happen to be all zero bits.
-- through sixth components of an extended node). Note we are cheating
-- a bit here when it comes to Node12, which really holds flags and (for
-- the third component), the convention. But it works because Empty,
-- False, Convention_Ada, all happen to be all zero bits.
Default_Node_Extension : constant Node_Record := (
Is_Extension => True,

View File

@ -6239,6 +6239,8 @@ package body Checks is
declare
DRC : constant Boolean := Do_Range_Check (Exp);
PV : Node_Id;
CE : Node_Id;
begin
Set_Do_Range_Check (Exp, False);
@ -6251,22 +6253,43 @@ package body Checks is
Force_Evaluation (Exp, Name_Req => True);
end if;
-- Insert the validity check. Note that we do this with validity
-- checks turned off, to avoid recursion, we do not want validity
-- checks on the validity checking code itself!
-- Build the prefix for the 'Valid call
Insert_Action
(Expr,
PV := Duplicate_Subexpr_No_Checks (Exp, Name_Req => True);
-- A rather specialized kludge. If PV is an analyzed expression
-- which is an indexed component of a packed array that has not
-- been properly expanded, turn off its Analyzed flag to make sure
-- it gets properly reexpanded.
-- The reason this arises is that Duplicate_Subexpr_No_Checks did
-- an analyze with the old parent pointer. This may point e.g. to
-- a subprogram call, which deactivates this expansion.
if Analyzed (PV)
and then Nkind (PV) = N_Indexed_Component
and then Present (Packed_Array_Type (Etype (Prefix (PV))))
then
Set_Analyzed (PV, False);
end if;
-- Build the raise CE node to check for validity
CE :=
Make_Raise_Constraint_Error (Loc,
Condition =>
Make_Op_Not (Loc,
Right_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
Duplicate_Subexpr_No_Checks (Exp, Name_Req => True),
Prefix => PV,
Attribute_Name => Name_Valid)),
Reason => CE_Invalid_Data),
Suppress => Validity_Check);
Reason => CE_Invalid_Data);
-- Insert the validity check. Note that we do this with validity
-- checks turned off, to avoid recursion, we do not want validity
-- checks on the validity checking code itself!
Insert_Action (Expr, CE, Suppress => Validity_Check);
-- If the expression is a reference to an element of a bit-packed
-- array, then it is rewritten as a renaming declaration. If the

View File

@ -244,6 +244,18 @@ package body Einfo is
-- Subprograms_For_Type Node29
-- (unused) Node30
-- (unused) Node31
-- (unused) Node32
-- (unused) Node33
-- (unused) Node34
-- (unused) Node35
---------------------------------------------
-- Usage of Flags in Defining Entity Nodes --
---------------------------------------------
@ -253,7 +265,7 @@ package body Einfo is
-- sense for them to be set true for certain subsets of entity kinds. See
-- the spec of Einfo for further details.
-- Note: Flag1-Flag3 are absent from this list, for historical reasons
-- Note: Flag1-Flag3 are not used, for historical reasons
-- Is_Frozen Flag4
-- Has_Discriminants Flag5
@ -533,6 +545,76 @@ package body Einfo is
-- (unused) Flag201
-- (unused) Flag255
-- (unused) Flag256
-- (unused) Flag257
-- (unused) Flag258
-- (unused) Flag259
-- (unused) Flag260
-- (unused) Flag261
-- (unused) Flag262
-- (unused) Flag263
-- (unused) Flag264
-- (unused) Flag265
-- (unused) Flag266
-- (unused) Flag267
-- (unused) Flag268
-- (unused) Flag269
-- (unused) Flag270
-- (unused) Flag271
-- (unused) Flag272
-- (unused) Flag273
-- (unused) Flag274
-- (unused) Flag275
-- (unused) Flag276
-- (unused) Flag277
-- (unused) Flag278
-- (unused) Flag279
-- (unused) Flag280
-- (unused) Flag281
-- (unused) Flag282
-- (unused) Flag283
-- (unused) Flag284
-- (unused) Flag285
-- (unused) Flag286
-- (unused) Flag287
-- (unused) Flag288
-- (unused) Flag289
-- (unused) Flag290
-- (unused) Flag291
-- (unused) Flag292
-- (unused) Flag293
-- (unused) Flag294
-- (unused) Flag295
-- (unused) Flag296
-- (unused) Flag297
-- (unused) Flag298
-- (unused) Flag299
-- (unused) Flag300
-- (unused) Flag301
-- (unused) Flag302
-- (unused) Flag303
-- (unused) Flag304
-- (unused) Flag305
-- (unused) Flag306
-- (unused) Flag307
-- (unused) Flag308
-- (unused) Flag309
-- (unused) Flag310
-- (unused) Flag311
-- (unused) Flag312
-- (unused) Flag313
-- (unused) Flag314
-- (unused) Flag315
-- (unused) Flag316
-- (unused) Flag317
-----------------------
-- Local subprograms --
-----------------------

View File

@ -5404,7 +5404,6 @@ package body Exp_Attr is
Ftp : Entity_Id;
begin
case Float_Rep (Btyp) is
-- For vax fpt types, call appropriate routine in special

View File

@ -3233,6 +3233,7 @@ package body Exp_Ch4 is
Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First);
Set_Parent (Opnd_Low_Bound (NN), Opnd);
-- Capture last operand bounds if result could be null
@ -3243,6 +3244,7 @@ package body Exp_Ch4 is
Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_First));
Set_Parent (Last_Opnd_Low_Bound, Opnd);
Last_Opnd_High_Bound :=
Convert_To (Ityp,
@ -3250,6 +3252,7 @@ package body Exp_Ch4 is
Prefix =>
Duplicate_Subexpr (Opnd, Name_Req => True),
Attribute_Name => Name_Last));
Set_Parent (Last_Opnd_High_Bound, Opnd);
end if;
-- Capture length of operand in entity

View File

@ -444,9 +444,7 @@ package body Exp_Util is
-- Handle private types
if Is_Private_Type (Utyp)
and then Present (Full_View (Utyp))
then
if Is_Private_Type (Utyp) and then Present (Full_View (Utyp)) then
Utyp := Full_View (Utyp);
end if;
@ -750,9 +748,7 @@ package body Exp_Util is
-- Primitive Finalize_Address is never generated in CodePeer mode
-- since it contains an Unchecked_Conversion.
if Needs_Finalization (Desig_Typ)
and then not CodePeer_Mode
then
if Needs_Finalization (Desig_Typ) and then not CodePeer_Mode then
Fin_Addr_Id := Find_Finalize_Address (Desig_Typ);
pragma Assert (Present (Fin_Addr_Id));
@ -1588,9 +1584,7 @@ package body Exp_Util is
-- It is only array and record types that cause trouble
if not Is_Record_Type (UT)
and then not Is_Array_Type (UT)
then
if not Is_Record_Type (UT) and then not Is_Array_Type (UT) then
return False;
-- If we know that we have a small (64 bits or less) record or small
@ -1598,8 +1592,7 @@ package body Exp_Util is
-- handle these cases correctly.
elsif Esize (Comp) <= 64
and then (Is_Record_Type (UT)
or else Is_Bit_Packed_Array (UT))
and then (Is_Record_Type (UT) or else Is_Bit_Packed_Array (UT))
then
return False;
@ -1740,7 +1733,6 @@ package body Exp_Util is
Name_Req : Boolean := False) return Node_Id
is
New_Exp : Node_Id;
begin
Remove_Side_Effects (Exp, Name_Req);
New_Exp := New_Copy_Tree (Exp);
@ -1775,9 +1767,7 @@ package body Exp_Util is
-- An itype reference must only be created if this is a local itype, so
-- that gigi can elaborate it on the proper objstack.
if Is_Itype (Typ)
and then Scope (Typ) = Current_Scope
then
if Is_Itype (Typ) and then Scope (Typ) = Current_Scope then
IR := Make_Itype_Reference (Sloc (N));
Set_Itype (IR, Typ);
Insert_Action (N, IR);
@ -1985,8 +1975,7 @@ package body Exp_Util is
-- standard string types and more generally arrays of characters.
if not Expander_Active
and then (No (Etype (Exp))
or else not Is_String_Type (Etype (Exp)))
and then (No (Etype (Exp)) or else not Is_String_Type (Etype (Exp)))
then
return;
end if;
@ -2179,9 +2168,7 @@ package body Exp_Util is
-- Handle private types
if Has_Private_Declaration (Typ)
and then Present (Full_View (Typ))
then
if Has_Private_Declaration (Typ) and then Present (Full_View (Typ)) then
Typ := Full_View (Typ);
end if;
@ -2309,9 +2296,7 @@ package body Exp_Util is
-- Handle private types
if Has_Private_Declaration (Typ)
and then Present (Full_View (Typ))
then
if Has_Private_Declaration (Typ) and then Present (Full_View (Typ)) then
Typ := Full_View (Typ);
end if;
@ -2374,7 +2359,7 @@ package body Exp_Util is
exit when Chars (Op) = Name
and then
(Name /= Name_Op_Eq
or else Etype (First_Formal (Op)) = Etype (Last_Formal (Op)));
or else Etype (First_Formal (Op)) = Etype (Last_Formal (Op)));
Next_Elmt (Prim);
@ -2446,10 +2431,7 @@ package body Exp_Util is
begin
S := Scop;
while Present (S) loop
if (Ekind (S) = E_Entry
or else Ekind (S) = E_Entry_Family
or else Ekind (S) = E_Function
or else Ekind (S) = E_Procedure)
if Ekind_In (S, E_Entry, E_Entry_Family, E_Function, E_Procedure)
and then Present (Protection_Object (S))
then
return Protection_Object (S);
@ -2634,9 +2616,8 @@ package body Exp_Util is
-- Deal with AND THEN and AND cases
if Nkind (Cond) = N_And_Then
or else Nkind (Cond) = N_Op_And
then
if Nkind_In (Cond, N_And_Then, N_Op_And) then
-- Don't ever try to invert a condition that is of the form of an
-- AND or AND THEN (since we are not doing sufficiently general
-- processing to allow this).
@ -2715,9 +2696,7 @@ package body Exp_Util is
-- reference had said var = True.
else
if Is_Entity_Name (Cond)
and then Ent = Entity (Cond)
then
if Is_Entity_Name (Cond) and then Ent = Entity (Cond) then
Val := New_Occurrence_Of (Standard_True, Sloc (Cond));
if Sens = False then
@ -2947,9 +2926,7 @@ package body Exp_Util is
T : constant Entity_Id := Etype (E);
begin
if Has_Per_Object_Constraint (E)
and then Has_Discriminants (T)
then
if Has_Per_Object_Constraint (E) and then Has_Discriminants (T) then
Disc := First_Discriminant (T);
while Present (Disc) loop
if Is_Access_Type (Etype (Disc)) then
@ -3437,9 +3414,7 @@ package body Exp_Util is
-- actions should be inserted outside the complete record
-- declaration.
elsif Nkind (Parent (P)) = N_Variant
or else Nkind (Parent (P)) = N_Record_Definition
then
elsif Nkind_In (Parent (P), N_Variant, N_Record_Definition) then
null;
-- Do not insert freeze nodes within the loop generated for
@ -3784,9 +3759,7 @@ package body Exp_Util is
Ins_Actions : List_Id)
is
begin
if Scope_Is_Transient
and then Assoc_Node = Node_To_Be_Wrapped
then
if Scope_Is_Transient and then Assoc_Node = Node_To_Be_Wrapped then
Store_After_Actions_In_Scope (Ins_Actions);
else
Insert_List_After_And_Analyze (Assoc_Node, Ins_Actions);
@ -3846,9 +3819,7 @@ package body Exp_Util is
begin
S := Current_Scope;
while Present (S)
and then S /= Standard_Standard
loop
while Present (S) and then S /= Standard_Standard loop
if Is_Init_Proc (S) then
return True;
else
@ -4139,7 +4110,7 @@ package body Exp_Util is
Next (Param);
end loop;
return Access_OK and then Alloc_OK;
return Access_OK and Alloc_OK;
end;
end if;
@ -4235,9 +4206,7 @@ package body Exp_Util is
elsif Nkind (Stmt) = N_Object_Renaming_Declaration then
Ren_Obj := Find_Renamed_Object (Stmt);
if Present (Ren_Obj)
and then Ren_Obj = Trans_Id
then
if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
return True;
end if;
end if;
@ -4439,8 +4408,7 @@ package body Exp_Util is
function Is_Library_Level_Tagged_Type (Typ : Entity_Id) return Boolean is
begin
return Is_Tagged_Type (Typ)
and then Is_Library_Level_Entity (Typ);
return Is_Tagged_Type (Typ) and then Is_Library_Level_Entity (Typ);
end Is_Library_Level_Tagged_Type;
--------------------------
@ -4700,7 +4668,7 @@ package body Exp_Util is
if Known_Alignment (Ptyp)
and then (Unknown_Alignment (Styp)
or else Alignment (Styp) > Alignment (Ptyp))
or else Alignment (Styp) > Alignment (Ptyp))
then
return True;
end if;
@ -4776,10 +4744,7 @@ package body Exp_Util is
return Is_Ref_To_Bit_Packed_Array (Renamed_Object (Entity (N)));
end if;
if Nkind (N) = N_Indexed_Component
or else
Nkind (N) = N_Selected_Component
then
if Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
if Is_Bit_Packed_Array (Etype (Prefix (N))) then
Result := True;
else
@ -4821,10 +4786,7 @@ package body Exp_Util is
then
return True;
elsif Nkind (N) = N_Indexed_Component
or else
Nkind (N) = N_Selected_Component
then
elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
return Is_Ref_To_Bit_Packed_Slice (Prefix (N));
else
@ -4971,9 +4933,9 @@ package body Exp_Util is
elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
if (Is_Entity_Name (Prefix (N))
and then Has_Volatile_Components (Entity (Prefix (N))))
and then Has_Volatile_Components (Entity (Prefix (N))))
or else (Present (Etype (Prefix (N)))
and then Has_Volatile_Components (Etype (Prefix (N))))
and then Has_Volatile_Components (Etype (Prefix (N))))
then
return True;
else
@ -4995,9 +4957,9 @@ package body Exp_Util is
and then (Nkind (N) = N_Slice
or else
(Nkind (N) = N_Identifier
and then Present (Renamed_Object (Entity (N)))
and then Nkind (Renamed_Object (Entity (N)))
= N_Slice));
and then Present (Renamed_Object (Entity (N)))
and then Nkind (Renamed_Object (Entity (N))) =
N_Slice));
end Is_VM_By_Copy_Actual;
--------------------
@ -5031,7 +4993,7 @@ package body Exp_Util is
and then
(In_Instance
or else (Present (Entity (C))
and then Has_Warnings_Off (Entity (C))))
and then Has_Warnings_Off (Entity (C))))
then
W := False;
end if;
@ -5137,15 +5099,12 @@ package body Exp_Util is
function Known_Non_Negative (Opnd : Node_Id) return Boolean is
begin
if Is_OK_Static_Expression (Opnd)
and then Expr_Value (Opnd) >= 0
then
if Is_OK_Static_Expression (Opnd) and then Expr_Value (Opnd) >= 0 then
return True;
else
declare
Lo : constant Node_Id := Type_Low_Bound (Etype (Opnd));
begin
return
Is_OK_Static_Expression (Lo) and then Expr_Value (Lo) >= 0;
@ -5751,9 +5710,7 @@ package body Exp_Util is
elsif Esize (Typ) /= 0 and then Esize (Typ) <= 256 then
return False;
elsif Is_Array_Type (Typ)
and then Present (Packed_Array_Type (Typ))
then
elsif Is_Array_Type (Typ) and then Present (Packed_Array_Type (Typ)) then
return May_Generate_Large_Temp (Packed_Array_Type (Typ));
-- We could do more here to find other small types ???
@ -5842,8 +5799,8 @@ package body Exp_Util is
or else Has_Some_Controlled_Component (T)
or else
(Is_Concurrent_Type (T)
and then Present (Corresponding_Record_Type (T))
and then Needs_Finalization (Corresponding_Record_Type (T)));
and then Present (Corresponding_Record_Type (T))
and then Needs_Finalization (Corresponding_Record_Type (T)));
end if;
end Needs_Finalization;
@ -5885,7 +5842,7 @@ package body Exp_Util is
or else Is_Access_Type (Typ)
or else
(Is_Bit_Packed_Array (Typ)
and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
and then Is_Modular_Integer_Type (Packed_Array_Type (Typ)))
then
return False;
@ -6519,7 +6476,32 @@ package body Exp_Util is
and then Is_Renaming_Of_Object (Entity (Original_Node (N)))
and then Ekind (Entity (Original_Node (N))) /= E_Constant
then
return False;
declare
RO : constant Node_Id :=
Renamed_Object (Entity (Original_Node (N)));
begin
-- If the renamed object is an indexed component, or an
-- explicit dereference, then the designated object could
-- be modified by an assignment.
if Nkind_In (RO, N_Indexed_Component,
N_Explicit_Dereference)
then
return False;
-- A selected component must have a safe prefix
elsif Nkind (RO) = N_Selected_Component then
return Safe_Prefixed_Reference (RO);
-- In all other cases, designated object cannot be changed so
-- we are side effect free.
else
return True;
end if;
end;
-- Remove_Side_Effects generates an object renaming declaration to
-- capture the expression of a class-wide expression. In VM targets
@ -6708,9 +6690,7 @@ package body Exp_Util is
elsif Is_Entity_Name (N) then
return Ekind (Entity (N)) = E_In_Parameter;
elsif Nkind (N) = N_Indexed_Component
or else Nkind (N) = N_Selected_Component
then
elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) then
return Within_In_Parameter (Prefix (N));
else
@ -6757,9 +6737,9 @@ package body Exp_Util is
if Is_Elementary_Type (Exp_Type)
and then (Variable_Ref
or else Nkind (Exp) = N_Function_Call
or else Nkind (Exp) = N_Attribute_Reference
or else Nkind (Exp) = N_Allocator
or else Nkind_In (Exp, N_Function_Call,
N_Attribute_Reference,
N_Allocator)
or else Nkind (Exp) in N_Op
or else (not Name_Req and then Is_Volatile_Reference (Exp)))
then
@ -6918,8 +6898,7 @@ package body Exp_Util is
-- by the expression it renames, which would defeat the purpose of
-- removing the side-effect.
if (Nkind (Exp) = N_Selected_Component
or else Nkind (Exp) = N_Indexed_Component)
if Nkind_In (Exp, N_Selected_Component, N_Indexed_Component)
and then Has_Non_Standard_Rep (Etype (Prefix (Exp)))
then
null;
@ -6933,9 +6912,7 @@ package body Exp_Util is
-- An expression which is in Alfa mode is considered side effect free
-- if the resulting value is captured by a variable or a constant.
if Alfa_Mode
and then Nkind (Parent (Exp)) = N_Object_Declaration
then
if Alfa_Mode and then Nkind (Parent (Exp)) = N_Object_Declaration then
goto Leave;
end if;
@ -7079,7 +7056,7 @@ package body Exp_Util is
begin
return Is_Scalar_Type (UT)
or else (Is_Bit_Packed_Array (UT)
and then Is_Scalar_Type (Packed_Array_Type (UT)));
and then Is_Scalar_Type (Packed_Array_Type (UT)));
end Represented_As_Scalar;
------------------------------
@ -7200,7 +7177,7 @@ package body Exp_Util is
elsif not Is_Imported (Obj_Id)
and then Needs_Finalization (Obj_Typ)
and then not (Ekind (Obj_Id) = E_Constant
and then not Has_Completion (Obj_Id))
and then not Has_Completion (Obj_Id))
and then not Is_Tag_To_Class_Wide_Conversion (Obj_Id)
then
return True;
@ -7241,7 +7218,7 @@ package body Exp_Util is
elsif Is_Access_Type (Obj_Typ)
and then Present (Status_Flag_Or_Transient_Decl (Obj_Id))
and then Nkind (Status_Flag_Or_Transient_Decl (Obj_Id)) =
N_Defining_Identifier
N_Defining_Identifier
and then Present (Expr)
and then Nkind (Expr) = N_Null
then
@ -7319,7 +7296,7 @@ package body Exp_Util is
(Available_View (Designated_Type (Typ))))
or else
(Is_Type (Typ)
and then Needs_Finalization (Typ)))
and then Needs_Finalization (Typ)))
and then Requires_Cleanup_Actions
(Actions (Decl), Lib_Level, Nested_Constructs)
then
@ -7338,17 +7315,15 @@ package body Exp_Util is
end if;
if Ekind (Pack_Id) /= E_Generic_Package
and then Requires_Cleanup_Actions
(Specification (Decl), Lib_Level)
and then
Requires_Cleanup_Actions (Specification (Decl), Lib_Level)
then
return True;
end if;
-- Nested package bodies
elsif Nested_Constructs
and then Nkind (Decl) = N_Package_Body
then
elsif Nested_Constructs and then Nkind (Decl) = N_Package_Body then
Pack_Id := Corresponding_Spec (Decl);
if Ekind (Pack_Id) /= E_Generic_Package
@ -7391,8 +7366,8 @@ package body Exp_Util is
if (Nkind (Pexp) = N_Assignment_Statement
and then Expression (Pexp) = Exp)
or else Nkind (Pexp) = N_Object_Declaration
or else Nkind (Pexp) = N_Object_Renaming_Declaration
or else Nkind_In (Pexp, N_Object_Declaration,
N_Object_Renaming_Declaration)
then
return True;
@ -7403,7 +7378,7 @@ package body Exp_Util is
-- introduce a temporary in this case.
elsif Nkind (Pexp) = N_Selected_Component
and then Prefix (Pexp) = Exp
and then Prefix (Pexp) = Exp
then
if No (Etype (Pexp)) then
return True;
@ -7491,7 +7466,7 @@ package body Exp_Util is
elsif Size_Known_At_Compile_Time (Otyp)
and then
(not Stack_Checking_Enabled
or else not May_Generate_Large_Temp (Otyp))
or else not May_Generate_Large_Temp (Otyp))
and then not (Is_Record_Type (Otyp) and then not Is_Constrained (Otyp))
then
return True;

View File

@ -4377,11 +4377,12 @@ ada/validsw.o : ada/ada.ads ada/a-unccon.ads ada/a-uncdea.ads \
ada/warnsw.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/err_vars.ads \
ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.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_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/warnsw.ads ada/warnsw.adb
ada/rident.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.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/targparm.ads ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
ada/warnsw.ads ada/warnsw.adb
ada/widechar.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/hostparm.ads ada/interfac.ads ada/opt.ads \

View File

@ -770,7 +770,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae vxworksmils,$(targ))),)
endif
# Sparc VxWorks
ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
ifeq ($(strip $(filter-out sparc% leon% wrs vx%,$(targ))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \
@ -797,7 +797,7 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
mlib-tgt-specific.adb<mlib-tgt-specific-vxworks.adb \
indepsw.adb<indepsw-gnu.adb
ifeq ($(arch),sparc)
ifeq ($(strip $(filter-out sparc erc32 leon leon3, $(arch))),)
# 32-bits
LIBGNAT_TARGET_PAIRS += \
s-vxwork.ads<s-vxwork-sparc.ads \
@ -1535,6 +1535,7 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
$(ATOMICS_BUILTINS_TARGET_PAIRS)
EXTRA_LIBGNAT_SRCS+=tb-ivms.c
override GNATRTL_ALTIVEC_OBJS=
TOOLS_TARGET_PAIRS= \
mlib-tgt-specific.adb<mlib-tgt-specific-vms-ia64.adb \
@ -2357,7 +2358,9 @@ ADA_EXCLUDE_SRCS =\
s-vxwexc.adb s-vxwexc.ads s-vxwext.adb s-vxwext.ads \
s-win32.ads s-winext.ads \
g-regist.adb g-regist.ads g-sse.ads g-ssvety.ads \
i-vxwoio.adb i-vxwoio.ads i-vxwork.ads
i-vxwoio.adb i-vxwoio.ads i-vxwork.ads \
g-allein.ads g-alleve.ads g-altcon.ads g-alveop.adb g-alvety.ads \
g-alleve.adb g-altcon.adb g-altive.ads g-alveop.ads g-alvevi.ads
# ADA_EXCLUDE_SRCS without the sources used by the target
ADA_EXCLUDE_FILES=$(filter-out \

View File

@ -11546,6 +11546,30 @@ The default alignment for the type @code{V} is 4, as a result of the
Integer field in the record, but it is permissible, as shown, to
override the default alignment of the record with a smaller value.
@cindex Alignment, subtypes
Note that according to the Ada standard, an alignment clause applies only
to the first named subtype. If additional subtypes are declared, then the
compiler is allowed to choose any alignment it likes, and there is no way
to control this choice. Consider:
@smallexample @c ada
type R is range 1 .. 10_000;
for R'Alignment use 1;
subtype RS is R range 1 .. 1000;
@end smallexample
@noindent
The alignment clause specifies an alignment of 1 for the first named subtype
@code{R} but this does not necessarily apply to @code{RS}. When writing
portable Ada code, you should avoid writing code that explicitly or
implicitly relies on the alignment of such subtypes.
For the GNAT compiler, if an explicit alignment clause is given, this
value is also used for any subsequent subtypes. So for GNAT, in the
above example, you can count on the alignment of @code{RS} being 1. But this
assumption is non-portable, and other compilers may choose different
alignments for the subtype @code{RS}.
@node Size Clauses
@section Size Clauses
@cindex Size Clause

View File

@ -5214,7 +5214,7 @@ individually controlled. The warnings that are not turned on by this
switch are
@option{-gnatwd} (implicit dereferencing),
@option{-gnatwh} (hiding),
@ifclear VMS
@ifclear vms
@option{-gnatw.d} (tag warnings with -gnatw switch)
@end ifclear
@option{-gnatw.h} (holes (gaps) in record layouts)

View File

@ -461,6 +461,11 @@ package body Prj is
if Iter.Current = No_Source then
Iter.Language := Iter.Language.Next;
Language_Changed (Iter);
elsif not Iter.Locally_Removed
and then Iter.Current.Locally_Removed
then
Next (Iter);
end if;
end if;
end Language_Changed;
@ -473,7 +478,8 @@ package body Prj is
(In_Tree : Project_Tree_Ref;
Project : Project_Id := No_Project;
Language : Name_Id := No_Name;
Encapsulated_Libs : Boolean := True) return Source_Iterator
Encapsulated_Libs : Boolean := True;
Locally_Removed : Boolean := True) return Source_Iterator
is
Iter : Source_Iterator;
begin
@ -484,7 +490,8 @@ package body Prj is
Language_Name => Language,
Language => No_Language_Index,
Current => No_Source,
Encapsulated_Libs => Encapsulated_Libs);
Encapsulated_Libs => Encapsulated_Libs,
Locally_Removed => Locally_Removed);
if Project /= null then
while Iter.Project /= null
@ -521,7 +528,14 @@ package body Prj is
procedure Next (Iter : in out Source_Iterator) is
begin
Iter.Current := Iter.Current.Next_In_Lang;
loop
Iter.Current := Iter.Current.Next_In_Lang;
exit when Iter.Locally_Removed
or else Iter.Current = No_Source
or else not Iter.Current.Locally_Removed;
end loop;
if Iter.Current = No_Source then
Iter.Language := Iter.Language.Next;
Language_Changed (Iter);

View File

@ -1466,10 +1466,12 @@ package Prj is
(In_Tree : Project_Tree_Ref;
Project : Project_Id := No_Project;
Language : Name_Id := No_Name;
Encapsulated_Libs : Boolean := True) return Source_Iterator;
Encapsulated_Libs : Boolean := True;
Locally_Removed : Boolean := True) return Source_Iterator;
-- Returns an iterator for all the sources of a project tree, or a specific
-- project, or a specific language. Include sources from aggregated libs if
-- Aggregated_Libs is True.
-- Aggregated_Libs is True. If Locally_Removed is set to False the
-- Locally_Removed files won't be reported.
function Element (Iter : Source_Iterator) return Source_Id;
-- Return the current source (or No_Source if there are no more sources)
@ -1923,6 +1925,8 @@ private
Encapsulated_Libs : Boolean;
-- True if we want to include the sources from encapsulated libs
Locally_Removed : Boolean;
end record;
procedure Add_To_Buffer

View File

@ -78,7 +78,7 @@ package Validsw is
Validity_Check_In_Params : Boolean := False;
-- Controls the validity checking of IN parameters. If this switch is
-- set to True using -gnatVm or an 'i' in the argument of a pragma
-- set to True using -gnatVi or an 'i' in the argument of a pragma
-- Validity_Checks, then the initial value of all IN parameters
-- will be checked at the point of call of a procedure or function.

View File

@ -22,9 +22,10 @@
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Targparm; use Targparm;
package body Warnsw is
----------------------------
@ -53,14 +54,14 @@ package body Warnsw is
Warn_On_Unrepped_Components := False;
when 'd' =>
if Open_VMS_On_Target then
if OpenVMS_On_Target then
return False;
end if;
Warning_Doc_Switch := True;
when 'D' =>
if Open_VMS_On_Target then
if OpenVMS_On_Target then
return False;
end if;
@ -76,7 +77,11 @@ package body Warnsw is
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
List_Inherited_Aspects := True;
Warning_Doc_Switch := True;
if not OpenVMS_On_Target then
Warning_Doc_Switch := True;
end if;
Warn_On_Ada_2005_Compatibility := True;
Warn_On_Ada_2012_Compatibility := True;
Warn_On_All_Unread_Out_Parameters := True;