aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2010-09-09 12:32:50 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2010-09-09 12:32:50 +0200
commitbd29d5193a42a7fbe92c5052fa8d28f35290c823 (patch)
tree29c9bde6be0184567a5d781848146e9b3c6e96b3
parent0e35524dec6e62dfe35360f11eee7c7031c5ab2e (diff)
downloadgcc-bd29d5193a42a7fbe92c5052fa8d28f35290c823.zip
gcc-bd29d5193a42a7fbe92c5052fa8d28f35290c823.tar.gz
gcc-bd29d5193a42a7fbe92c5052fa8d28f35290c823.tar.bz2
[multiple changes]
2010-09-09 Vincent Celier <celier@adacore.com> * osint.adb (Canonical_Case_File_Name): Use procedure To_Lower in System.Case_Util (Canonical_Case_Env_Var_Name): Ditto 2010-09-09 Bob Duff <duff@adacore.com> * g-pehage.adb (Allocate): Initialize the allocated elements of IT. 2010-09-09 Robert Dewar <dewar@adacore.com> * cstand.adb: Mark Boolean and Character types as Ordered * einfo.adb (Has_Pragma_Ordered): New flag * einfo.ads (Has_Pragma_Ordered): New flag * g-calend.ads: Mark Day_Name as Ordered * opt.ads: Mark Ada_Version_Type as Ordered (Warn_On_Unordered_Enumeration_Type): New flag * par-prag.adb: Add procdessing for pragma Ordered * s-ficobl.ads (Read_File_Mode): New subtype * s-fileio.adb: Use Read_File_Mode instead of explicit ranges * s-taskin.ads: Mark Entry_Call_State as ordered * sem_ch3.adb (Build_Derived_Enumeration_Type): Inherit Has_Pragma_Ordered. * sem_ch6.ads: Mark Conformance_Type as Ordered * sem_prag.adb: Implement pragma Ordered * sem_res.adb (Bad_Unordered_Enumeration_Reference): New function (Resolve_Comparison_Op): Diagnose unordered comparison (Resolve_Range): Diagnose unordered range * sem_warn.adb (Warn_On_Unordered_Enumeration_Type): New flag (from -gnatw.u/U) * snames.ads-tmpl: Add entry for pragma Ordered * style.ads (Check_Enumeration_Subrange): Removed * styleg.adb (Check_Enumeration_Subrange): Removed * styleg.ads (Check_Enumeration_Subrange): Removed * stylesw.adb: Remove handling of -gnatyE switch * stylesw.ads: (Style_Check_Enumeration_Subranges): Removed * vms_data.ads: Remove -gnatyE entries Add -gnatw.u entries * ug_words: Entries for -gnatw.u and -gnatw.U * gnat_ugn.texi: Document -gnatw.u/-gnatw.U switches * gnat_rm.texi: Document pragma Ordered. * s-tasren.adb: Avoid unnecessary comparison on unordered enumeration. * s-tpobop.adb: Remove comparison on unordered enumeration type. From-SVN: r164070
-rw-r--r--gcc/ada/ChangeLog45
-rw-r--r--gcc/ada/cstand.adb4
-rw-r--r--gcc/ada/einfo.adb19
-rw-r--r--gcc/ada/einfo.ads15
-rw-r--r--gcc/ada/g-calend.ads13
-rw-r--r--gcc/ada/g-pehage.adb10
-rw-r--r--gcc/ada/gnat_rm.texi96
-rw-r--r--gcc/ada/gnat_ugn.texi25
-rw-r--r--gcc/ada/opt.ads8
-rw-r--r--gcc/ada/osint.adb21
-rw-r--r--gcc/ada/par-prag.adb3
-rw-r--r--gcc/ada/s-ficobl.ads3
-rw-r--r--gcc/ada/s-fileio.adb4
-rw-r--r--gcc/ada/s-taskin.ads41
-rw-r--r--gcc/ada/s-tasren.adb4
-rw-r--r--gcc/ada/s-tpobop.adb36
-rw-r--r--gcc/ada/sem_ch3.adb5
-rw-r--r--gcc/ada/sem_ch6.ads4
-rw-r--r--gcc/ada/sem_prag.adb41
-rw-r--r--gcc/ada/sem_res.adb129
-rw-r--r--gcc/ada/sem_warn.adb9
-rw-r--r--gcc/ada/snames.ads-tmpl2
-rw-r--r--gcc/ada/style.ads3
-rw-r--r--gcc/ada/styleg.adb80
-rw-r--r--gcc/ada/styleg.ads4
-rw-r--r--gcc/ada/stylesw.adb9
-rw-r--r--gcc/ada/stylesw.ads6
-rw-r--r--gcc/ada/ug_words2
-rw-r--r--gcc/ada/usage.adb3
-rw-r--r--gcc/ada/vms_data.ads8
30 files changed, 436 insertions, 216 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8f423231..54bd5d9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,50 @@
2010-09-09 Vincent Celier <celier@adacore.com>
+ * osint.adb (Canonical_Case_File_Name): Use procedure To_Lower in
+ System.Case_Util
+ (Canonical_Case_Env_Var_Name): Ditto
+
+2010-09-09 Bob Duff <duff@adacore.com>
+
+ * g-pehage.adb (Allocate): Initialize the allocated elements of IT.
+
+2010-09-09 Robert Dewar <dewar@adacore.com>
+
+ * cstand.adb: Mark Boolean and Character types as Ordered
+ * einfo.adb (Has_Pragma_Ordered): New flag
+ * einfo.ads (Has_Pragma_Ordered): New flag
+ * g-calend.ads: Mark Day_Name as Ordered
+ * opt.ads: Mark Ada_Version_Type as Ordered
+ (Warn_On_Unordered_Enumeration_Type): New flag
+ * par-prag.adb: Add procdessing for pragma Ordered
+ * s-ficobl.ads (Read_File_Mode): New subtype
+ * s-fileio.adb: Use Read_File_Mode instead of explicit ranges
+ * s-taskin.ads: Mark Entry_Call_State as ordered
+ * sem_ch3.adb (Build_Derived_Enumeration_Type): Inherit
+ Has_Pragma_Ordered.
+ * sem_ch6.ads: Mark Conformance_Type as Ordered
+ * sem_prag.adb: Implement pragma Ordered
+ * sem_res.adb (Bad_Unordered_Enumeration_Reference): New function
+ (Resolve_Comparison_Op): Diagnose unordered comparison
+ (Resolve_Range): Diagnose unordered range
+ * sem_warn.adb (Warn_On_Unordered_Enumeration_Type): New flag (from
+ -gnatw.u/U)
+ * snames.ads-tmpl: Add entry for pragma Ordered
+ * style.ads (Check_Enumeration_Subrange): Removed
+ * styleg.adb (Check_Enumeration_Subrange): Removed
+ * styleg.ads (Check_Enumeration_Subrange): Removed
+ * stylesw.adb: Remove handling of -gnatyE switch
+ * stylesw.ads: (Style_Check_Enumeration_Subranges): Removed
+ * vms_data.ads: Remove -gnatyE entries
+ Add -gnatw.u entries
+ * ug_words: Entries for -gnatw.u and -gnatw.U
+ * gnat_ugn.texi: Document -gnatw.u/-gnatw.U switches
+ * gnat_rm.texi: Document pragma Ordered.
+ * s-tasren.adb: Avoid unnecessary comparison on unordered enumeration.
+ * s-tpobop.adb: Remove comparison on unordered enumeration type.
+
+2010-09-09 Vincent Celier <celier@adacore.com>
+
* adaint.c: New function __gnat_get_env_vars_case_sensitive, returns 0
for VMS and Windows, and 1 for all other platforms.
* adaint.h: New function __gnat_get_env_vars_case_sensitive
diff --git a/gcc/ada/cstand.adb b/gcc/ada/cstand.adb
index 9f9332b..bc85f0c 100644
--- a/gcc/ada/cstand.adb
+++ b/gcc/ada/cstand.adb
@@ -446,6 +446,7 @@ package body CStand is
Set_Is_Unsigned_Type (Standard_Boolean);
Set_Size_Known_At_Compile_Time (Standard_Boolean);
+ Set_Has_Pragma_Ordered (Standard_Boolean);
Set_Ekind (Standard_True, E_Enumeration_Literal);
Set_Etype (Standard_True, Standard_Boolean);
@@ -566,6 +567,7 @@ package body CStand is
Init_RM_Size (Standard_Character, 8);
Set_Elem_Alignment (Standard_Character);
+ Set_Has_Pragma_Ordered (Standard_Character);
Set_Is_Unsigned_Type (Standard_Character);
Set_Is_Character_Type (Standard_Character);
Set_Is_Known_Valid (Standard_Character);
@@ -611,6 +613,7 @@ package body CStand is
Init_Size (Standard_Wide_Character, Standard_Wide_Character_Size);
Set_Elem_Alignment (Standard_Wide_Character);
+ Set_Has_Pragma_Ordered (Standard_Wide_Character);
Set_Is_Unsigned_Type (Standard_Wide_Character);
Set_Is_Character_Type (Standard_Wide_Character);
Set_Is_Known_Valid (Standard_Wide_Character);
@@ -658,6 +661,7 @@ package body CStand is
Standard_Wide_Wide_Character_Size);
Set_Elem_Alignment (Standard_Wide_Wide_Character);
+ Set_Has_Pragma_Ordered (Standard_Wide_Wide_Character);
Set_Is_Unsigned_Type (Standard_Wide_Wide_Character);
Set_Is_Character_Type (Standard_Wide_Wide_Character);
Set_Is_Known_Valid (Standard_Wide_Wide_Character);
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 21320af..2310895 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -456,6 +456,7 @@ package body Einfo is
-- Is_Primitive_Wrapper Flag195
-- Was_Hidden Flag196
-- Is_Limited_Interface Flag197
+ -- Has_Pragma_Ordered Flag198
-- Has_Anon_Block_Suffix Flag201
-- Itype_Printed Flag202
@@ -509,7 +510,6 @@ package body Einfo is
-- Is_Underlying_Record_View Flag246
-- OK_To_Rename Flag247
- -- (unused) Flag198
-- (unused) Flag199
-- (unused) Flag200
@@ -726,8 +726,7 @@ package body Einfo is
function Corresponding_Protected_Entry (Id : E) return E is
begin
- pragma Assert
- (Ekind (Id) = E_Subprogram_Body);
+ pragma Assert (Ekind (Id) = E_Subprogram_Body);
return Node18 (Id);
end Corresponding_Protected_Entry;
@@ -1344,6 +1343,12 @@ package body Einfo is
return Flag230 (Id);
end Has_Pragma_Inline_Always;
+ function Has_Pragma_Ordered (Id : E) return B is
+ begin
+ pragma Assert (Is_Enumeration_Type (Id));
+ return Flag198 (Implementation_Base_Type (Id));
+ end Has_Pragma_Ordered;
+
function Has_Pragma_Pack (Id : E) return B is
begin
pragma Assert (Is_Record_Type (Id) or else Is_Array_Type (Id));
@@ -3753,6 +3758,13 @@ package body Einfo is
Set_Flag230 (Id, V);
end Set_Has_Pragma_Inline_Always;
+ procedure Set_Has_Pragma_Ordered (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Enumeration_Type (Id));
+ pragma Assert (Id = Base_Type (Id));
+ Set_Flag198 (Id, V);
+ end Set_Has_Pragma_Ordered;
+
procedure Set_Has_Pragma_Pack (Id : E; V : B := True) is
begin
pragma Assert (Is_Array_Type (Id) or else Is_Record_Type (Id));
@@ -6901,6 +6913,7 @@ package body Einfo is
W ("Has_Pragma_Elaborate_Body", Flag150 (Id));
W ("Has_Pragma_Inline", Flag157 (Id));
W ("Has_Pragma_Inline_Always", Flag230 (Id));
+ W ("Has_Pragma_Ordered", Flag198 (Id));
W ("Has_Pragma_Pack", Flag121 (Id));
W ("Has_Pragma_Preelab_Init", Flag221 (Id));
W ("Has_Pragma_Pure", Flag203 (Id));
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 3dd0a5c..7a396c7 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -632,8 +632,8 @@ package Einfo is
-- where Comes_From_Source is always False.
-- Corresponding_Protected_Entry (Node18)
--- Present in subrogram bodies. Denotes the entry of a protected type
--- that is implemented by the subprogram body.
+-- Present in subrogram bodies. Set for subprogram bodies that implement
+-- a protected type entry to point to the entity for the entry.
-- Corresponding_Record_Type (Node18)
-- Present in protected and task types and subtypes. References the
@@ -1578,6 +1578,12 @@ package Einfo is
-- pragma Inline_Always applies. Note that if this flag is set, the flag
-- Has_Pragma_Inline is also set.
+-- Has_Pragma_Ordered (Flag198) [implementation base type only]
+-- Present in entities for enumeration types. If set indicates that a
+-- valid pragma Ordered was given for the type. This flag is inherited
+-- by derived enumeration types. We don't need to distinguish the derived
+-- case since we allow multiple occurrences of this pragma anyway.
+
-- Has_Pragma_Pack (Flag121) [implementation base type only]
-- Present in all entities. If set, indicates that a valid pragma Pack
-- was given for the type. Note that this flag is not inherited by
@@ -4967,6 +4973,7 @@ package Einfo is
-- Has_Biased_Representation (Flag139)
-- Has_Contiguous_Rep (Flag181)
-- Has_Enumeration_Rep_Clause (Flag66)
+ -- Has_Pragma_Ordered (Flag198) (base type only)
-- Nonzero_Is_True (Flag162) (base type only)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
@@ -5879,6 +5886,7 @@ package Einfo is
function Has_Pragma_Elaborate_Body (Id : E) return B;
function Has_Pragma_Inline (Id : E) return B;
function Has_Pragma_Inline_Always (Id : E) return B;
+ function Has_Pragma_Ordered (Id : E) return B;
function Has_Pragma_Pack (Id : E) return B;
function Has_Pragma_Preelab_Init (Id : E) return B;
function Has_Pragma_Pure (Id : E) return B;
@@ -6438,6 +6446,7 @@ package Einfo is
procedure Set_Has_Pragma_Elaborate_Body (Id : E; V : B := True);
procedure Set_Has_Pragma_Inline (Id : E; V : B := True);
procedure Set_Has_Pragma_Inline_Always (Id : E; V : B := True);
+ procedure Set_Has_Pragma_Ordered (Id : E; V : B := True);
procedure Set_Has_Pragma_Pack (Id : E; V : B := True);
procedure Set_Has_Pragma_Preelab_Init (Id : E; V : B := True);
procedure Set_Has_Pragma_Pure (Id : E; V : B := True);
@@ -7095,6 +7104,7 @@ package Einfo is
pragma Inline (Has_Pragma_Elaborate_Body);
pragma Inline (Has_Pragma_Inline);
pragma Inline (Has_Pragma_Inline_Always);
+ pragma Inline (Has_Pragma_Ordered);
pragma Inline (Has_Pragma_Pack);
pragma Inline (Has_Pragma_Preelab_Init);
pragma Inline (Has_Pragma_Pure);
@@ -7526,6 +7536,7 @@ package Einfo is
pragma Inline (Set_Has_Pragma_Elaborate_Body);
pragma Inline (Set_Has_Pragma_Inline);
pragma Inline (Set_Has_Pragma_Inline_Always);
+ pragma Inline (Set_Has_Pragma_Ordered);
pragma Inline (Set_Has_Pragma_Pack);
pragma Inline (Set_Has_Pragma_Preelab_Init);
pragma Inline (Set_Has_Pragma_Pure);
diff --git a/gcc/ada/g-calend.ads b/gcc/ada/g-calend.ads
index 39ca203..9dd5ae0 100644
--- a/gcc/ada/g-calend.ads
+++ b/gcc/ada/g-calend.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1999-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -33,11 +33,11 @@
-- Second_Duration and Day_Of_Week and Day_In_Year from Calendar.Time.
-- Second_Duration precision depends on the target clock precision.
--
--- GNAT.Calendar provides the same kind of abstraction found in
--- Ada.Calendar. It provides Split and Time_Of to build and split a Time
--- data. And it provides accessor functions to get only one of Hour, Minute,
--- Second, Second_Duration. Other functions are to access more advanced
--- values like Day_Of_Week, Day_In_Year and Week_In_Year.
+-- GNAT.Calendar provides the same kind of abstraction found in Ada.Calendar.
+-- It provides Split and Time_Of to build and split a Time data. And it
+-- provides accessor functions to get only one of Hour, Minute, Second,
+-- Second_Duration. Other functions are to access more advanced values like
+-- Day_Of_Week, Day_In_Year and Week_In_Year.
with Ada.Calendar;
with Interfaces.C;
@@ -46,6 +46,7 @@ package GNAT.Calendar is
type Day_Name is
(Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday);
+ pragma Ordered (Day_Name);
subtype Hour_Number is Natural range 0 .. 23;
subtype Minute_Number is Natural range 0 .. 59;
diff --git a/gcc/ada/g-pehage.adb b/gcc/ada/g-pehage.adb
index b59e1ec..1b48018 100644
--- a/gcc/ada/g-pehage.adb
+++ b/gcc/ada/g-pehage.adb
@@ -553,10 +553,18 @@ package body GNAT.Perfect_Hash_Generators is
-- Allocate --
--------------
- function Allocate (N : Natural; S : Natural := 1) return Table_Id is
+ function Allocate (N : Natural; S : Natural := 1) return Table_Id is
L : constant Integer := IT.Last;
begin
IT.Set_Last (L + N * S);
+
+ -- Initialize, so debugging printouts don't trip over uninitialized
+ -- components.
+
+ for J in L + 1 .. IT.Last loop
+ IT.Table (J) := -1;
+ end loop;
+
return L + 1;
end Allocate;
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index e4a39e1..933978e 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -173,6 +173,7 @@ Implementation Defined Pragmas
* Pragma Normalize_Scalars::
* Pragma Obsolescent::
* Pragma Optimize_Alignment::
+* Pragma Ordered::
* Pragma Passive::
* Pragma Persistent_BSS::
* Pragma Polling::
@@ -789,6 +790,7 @@ consideration, the use of these pragmas should be minimized.
* Pragma Normalize_Scalars::
* Pragma Obsolescent::
* Pragma Optimize_Alignment::
+* Pragma Ordered::
* Pragma Passive::
* Pragma Persistent_BSS::
* Pragma Polling::
@@ -3731,6 +3733,96 @@ unit are excluded from the consistency check, as are all predefined units. The
latter are compiled by default in pragma Optimize_Alignment (Off) mode if no
pragma appears at the start of the file.
+@node Pragma Ordered
+@unnumberedsec Pragma Ordered
+@findex Ordered
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Ordered (enumeration_first_subtype_LOCAL_NAME);
+@end smallexample
+
+@noindent
+Most enumeration types are from a conceptual point of view unordered.
+For example, if we write:
+
+@smallexample @c ada
+type Color is (Red, Blue, Green, Yellow);
+@end smallexample
+
+@noindent
+Then Ada semantics says that Blue > Red, and Green > Blue, but really
+these relations make no sense, the enumeration type merely specifies
+a set of possible colors, and the order is unimportant.
+
+@noindent
+For such unordered enumeration types, it is generally a good idea if
+clients avoid comparisons (other than equality or inequality), or
+explicit ranges. For example, if we have code buried in some client
+that says:
+
+@smallexample @c ada
+if Current_Color < Yellow ....
+if Current_Color in Blue .. Green
+@end smallexample
+
+@noindent
+Then the code is relying on the order, which is undesriable in this case.
+It makes the code hard to read and creates maintenance difficulties if
+entries have to be added to the enumeration type. In cases like this,
+we prefer if the code in the client lists the possibilities, or an
+appropriate subtype is declared in the parent package, e.g. for the
+above case, we might have in the parent package:
+
+@smallexample @c ada
+subtype RBG is Color range Red .. Green;
+@end smallexample
+
+@noindent
+and then in the client we could write:
+
+@smallexample @c ada
+if Current_Color in RBG ....
+if Current_Color = Blue or Current_Color = Green ...
+@end smallexample
+
+@noindent
+
+However some enumeration types are legitimately ordered from a conceptual
+point of view. For example, if you have:
+
+@smallexample @c ada
+type Day is (Mon, Tue, Wed, Thu, Fri, Sat, Sun);
+@end smallexample
+
+@noindent
+then the ordering imposed by the language is reasonable, and it
+is fine for clients to depend on this, writing for example:
+
+@smallexample @c ada
+if D in Mon .. Fri then
+if D < Wed
+@end smallexample
+
+@noindent
+pragma @option{Order} is provided to mark enumeration types that
+are conceptually ordered, warning the reader that clients may depend
+on the ordering. We provide a pragma to mark enumerations as Ordered
+rather than one to mark them as Unordered, since in our experience,
+the great majority of enumeration types are conceptually Unordered.
+
+The types Boolean, Character, Wide_Character, and Wide_Wide_Character
+are considered to be ordered types, so there is a pragma Ordered
+present in Standard for these types.
+
+Normally pragma Order serves as only documentation and a guide for
+coding standards, but GNAT provides a warning switch -gnatw.u that
+requests warnings for inappropriate uses (comparisons and explicit
+subranges) for unordered types. If this switch is used, then any
+enumeration type not marked with pragma Ordered will be considered
+as unordered, and will generate warnings for inappropriate uses.
+
@node Pragma Passive
@unnumberedsec Pragma Passive
@findex Passive
@@ -5745,11 +5837,11 @@ may raise @code{Constraint_Error}.
@cindex Representation of enums
@findex Enum_Val
@noindent
-For every enumeration subtype @var{S}, @code{@var{S}'Enum_Rep} denotes a
+For every enumeration subtype @var{S}, @code{@var{S}'Enum_Val} denotes a
function with the following spec:
@smallexample @c ada
-function @var{S}'Enum_Rep (Arg : @i{Universal_Integer)
+function @var{S}'Enum_Val (Arg : @i{Universal_Integer)
return @var{S}'Base};
@end smallexample
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 76d555a..3d5eaf3 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -5627,6 +5627,23 @@ This switch suppresses warnings for unused entities and packages.
It also turns off warnings on unreferenced formals (and thus includes
the effect of @option{-gnatwF}).
+@item -gnatw.u
+@emph{Activate warnings on unordered enumeration types.}
+@cindex @option{-gnatw.u} (@command{gcc})
+This switch causes enumeration types to be considered as conceptually
+unordered, unless an explicit pragma Order is given for the type. The
+effect is to generate warnings in clients that use explicit comparisons
+or subranges, since these constructs both treat objects of the type as
+ordered. A client is defined as a unit that is other than the unit in
+which the type is declared, or its body or subunits. See description
+of pragma Order in the GNAT RM for further details.
+
+@item -gnatw.U
+@emph{Deactivate warnings on unordered enumeration types.}
+@cindex @option{-gnatw.U} (@command{gcc})
+This switch causes all enumeration types to be considered as ordered, so
+that no warnings are given for comparisons or subranges for any type.
+
@item -gnatwv
@emph{Activate warnings on unassigned variables.}
@cindex @option{-gnatwv} (@command{gcc})
@@ -6255,14 +6272,6 @@ allowed).
Optional labels on @code{end} statements ending subprograms and on
@code{exit} statements exiting named loops, are required to be present.
-@item ^E^ENUMERATION_RANGES^
-@emph{Check enumeration ranges.}
-Explicit subranges of enumeration types (e.g. in loops or membership tests)
-are not allowed unless the subrange occurs in the same package as the type
-declaration, or its body or subunits. Standard types (such as Boolean and
-Character) are excluded, allowing for example the range 'A'..'Z'. In addition
-an explicit reference to X'First..X'Last (equivalent to X'Range) is allowed.
-
@item ^f^VTABS^
@emph{No form feeds or vertical tabs.}
Neither form feeds nor vertical tab characters are permitted
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 6f0b6d9..4107b0c 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -65,6 +65,7 @@ package Opt is
-- Set True if binder file to be generated in Ada rather than C
type Ada_Version_Type is (Ada_83, Ada_95, Ada_05, Ada_12);
+ pragma Ordered (Ada_Version_Type);
-- Versions of Ada for Ada_Version below. Note that these are ordered,
-- so that tests like Ada_Version >= Ada_95 are legitimate and useful.
@@ -1456,6 +1457,13 @@ package Opt is
-- non-portable semantics (e.g. because sizes of types differ). The default
-- is that this warning is enabled.
+ Warn_On_Unordered_Enumeration_Type : Boolean := False;
+ -- GNAT
+ -- Set to True to generate warnings for inappropriate uses (comparisons
+ -- and explicit ranges) on unordered enumeration types (which includes
+ -- all enumeration types for which pragma Ordered is not given). The
+ -- default is that this warning is disabled.
+
Warn_On_Unrecognized_Pragma : Boolean := True;
-- GNAT
-- Set to True to generate warnings for unrecognized pragmas. The default
diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb
index 5ecf7fa..f4f879f 100644
--- a/gcc/ada/osint.adb
+++ b/gcc/ada/osint.adb
@@ -688,20 +688,10 @@ package body Osint is
-- Canonical_Case_File_Name --
------------------------------
- -- For now, we only deal with the case of a-z. Eventually we should
- -- worry about other Latin-1 letters on systems that support this ???
-
procedure Canonical_Case_File_Name (S : in out String) is
begin
if not File_Names_Case_Sensitive then
- for J in S'Range loop
- if S (J) in 'A' .. 'Z' then
- S (J) :=
- Character'Val
- (Character'Pos (S (J)) +
- (Character'Pos ('a') - Character'Pos ('A')));
- end if;
- end loop;
+ To_Lower (S);
end if;
end Canonical_Case_File_Name;
@@ -712,14 +702,7 @@ package body Osint is
procedure Canonical_Case_Env_Var_Name (S : in out String) is
begin
if not Env_Vars_Case_Sensitive then
- for J in S'Range loop
- if S (J) in 'A' .. 'Z' then
- S (J) := Character'Val (
- Character'Pos (S (J)) +
- Character'Pos ('a') -
- Character'Pos ('A'));
- end if;
- end loop;
+ To_Lower (S);
end if;
end Canonical_Case_Env_Var_Name;
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index a421592..acc941e 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1156,10 +1156,11 @@ begin
Pragma_Memory_Size |
Pragma_No_Body |
Pragma_No_Return |
- Pragma_Obsolescent |
Pragma_No_Run_Time |
Pragma_No_Strict_Aliasing |
Pragma_Normalize_Scalars |
+ Pragma_Obsolescent |
+ Pragma_Ordered |
Pragma_Optimize |
Pragma_Optimize_Alignment |
Pragma_Pack |
diff --git a/gcc/ada/s-ficobl.ads b/gcc/ada/s-ficobl.ads
index f58ae6c..c8f6bc6 100644
--- a/gcc/ada/s-ficobl.ads
+++ b/gcc/ada/s-ficobl.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@@ -60,6 +60,7 @@ package System.File_Control_Block is
-- Used to hold name and form strings
type File_Mode is (In_File, Inout_File, Out_File, Append_File);
+ subtype Read_File_Mode is File_Mode range In_File .. Inout_File;
-- File mode (union of file modes permitted by individual packages,
-- the types File_Mode in the individual packages are declared to
-- allow easy conversion to and from this general type.
diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb
index 185fc52..2142e49 100644
--- a/gcc/ada/s-fileio.adb
+++ b/gcc/ada/s-fileio.adb
@@ -205,7 +205,7 @@ package body System.File_IO is
begin
if File = null then
raise Status_Error with "file not open";
- elsif File.Mode > Inout_File then
+ elsif File.Mode not in Read_File_Mode then
raise Mode_Error with "file not readable";
end if;
end Check_Read_Status;
@@ -1183,7 +1183,7 @@ package body System.File_IO is
-- reopen.
if Mode = File.Mode
- and then Mode <= Inout_File
+ and then Mode in Read_File_Mode
then
rewind (File.Stream);
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 0cc43f3..104a3a6 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -282,32 +282,31 @@ package System.Tasking is
Cancelled
-- the call was asynchronous, and was cancelled
);
+ pragma Ordered (Entry_Call_State);
- -- Never_Abortable is used for calls that are made in a abort
- -- deferred region (see ARM 9.8(5-11), 9.8 (20)).
- -- Such a call is never abortable.
+ -- Never_Abortable is used for calls that are made in a abort deferred
+ -- region (see ARM 9.8(5-11), 9.8 (20)). Such a call is never abortable.
- -- The Was_ vs. Not_Yet_ distinction is needed to decide whether it
- -- is OK to advance into the abortable part of an async. select stmt.
- -- That is allowed iff the mode is Now_ or Was_.
+ -- The Was_ vs. Not_Yet_ distinction is needed to decide whether it is OK
+ -- to advance into the abortable part of an async. select stmt. That is
+ -- allowed iff the mode is Now_ or Was_.
- -- Done indicates the call has been completed, without cancellation,
- -- or no call has been made yet at this ATC nesting level,
- -- and so aborting the call is no longer an issue.
- -- Completion of the call does not necessarily indicate "success";
- -- the call may be returning an exception if Exception_To_Raise is
- -- non-null.
+ -- Done indicates the call has been completed, without cancellation, or no
+ -- call has been made yet at this ATC nesting level, and so aborting the
+ -- call is no longer an issue. Completion of the call does not necessarily
+ -- indicate "success"; the call may be returning an exception if
+ -- Exception_To_Raise is non-null.
- -- Cancelled indicates the call was cancelled,
- -- and so aborting the call is no longer an issue.
+ -- Cancelled indicates the call was cancelled, and so aborting the call is
+ -- no longer an issue.
- -- The call is on an entry queue unless
- -- State >= Done, in which case it may or may not be still Onqueue.
+ -- The call is on an entry queue unless State >= Done, in which case it may
+ -- or may not be still Onqueue.
- -- Please do not modify the order of the values, without checking
- -- all uses of this type. We rely on partial "monotonicity" of
- -- Entry_Call_Record.State to avoid locking when we access this
- -- value for certain tests. In particular:
+ -- Please do not modify the order of the values, without checking all uses
+ -- of this type. We rely on partial "monotonicity" of
+ -- Entry_Call_Record.State to avoid locking when we access this value for
+ -- certain tests. In particular:
-- 1) Once State >= Done, we can rely that the call has been
-- completed. If State >= Done, it will not
diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb
index 35e0dd3..1ea6699 100644
--- a/gcc/ada/s-tasren.adb
+++ b/gcc/ada/s-tasren.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -1268,7 +1268,7 @@ package body System.Tasking.Rendezvous is
if Old_State /= Entry_Call.State
and then Entry_Call.State = Now_Abortable
- and then Entry_Call.Mode > Simple_Call
+ and then Entry_Call.Mode /= Simple_Call
and then Entry_Call.Self /= Self_ID
-- Asynchronous_Call or Conditional_Call
diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb
index 13688e6..f9ca610 100644
--- a/gcc/ada/s-tpobop.adb
+++ b/gcc/ada/s-tpobop.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2010, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@@ -646,26 +646,26 @@ package body System.Tasking.Protected_Objects.Operations is
end if;
end if;
- elsif Mode < Asynchronous_Call then
-
- -- Simple_Call or Conditional_Call
-
- if Single_Lock then
- STPO.Lock_RTS;
- Entry_Calls.Wait_For_Completion (Entry_Call);
- STPO.Unlock_RTS;
+ else
+ case Mode is
+ when Simple_Call | Conditional_Call =>
+ if Single_Lock then
+ STPO.Lock_RTS;
+ Entry_Calls.Wait_For_Completion (Entry_Call);
+ STPO.Unlock_RTS;
- else
- STPO.Write_Lock (Self_ID);
- Entry_Calls.Wait_For_Completion (Entry_Call);
- STPO.Unlock (Self_ID);
- end if;
+ else
+ STPO.Write_Lock (Self_ID);
+ Entry_Calls.Wait_For_Completion (Entry_Call);
+ STPO.Unlock (Self_ID);
+ end if;
- Block.Cancelled := Entry_Call.State = Cancelled;
+ Block.Cancelled := Entry_Call.State = Cancelled;
- else
- pragma Assert (False);
- null;
+ when Asynchronous_Call | Timed_Call =>
+ pragma Assert (False);
+ null;
+ end case;
end if;
Initialization.Undefer_Abort_Nestable (Self_ID);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7708b8b..c926e09 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5375,9 +5375,14 @@ package body Sem_Ch3 is
Set_RM_Size (Implicit_Base, RM_Size (Parent_Type));
Set_First_Rep_Item (Implicit_Base, First_Rep_Item (Parent_Type));
+ -- Copy other flags from parent type
+
Set_Has_Non_Standard_Rep
(Implicit_Base, Has_Non_Standard_Rep
(Parent_Type));
+ Set_Has_Pragma_Ordered
+ (Implicit_Base, Has_Pragma_Ordered
+ (Parent_Type));
Set_Has_Delayed_Freeze (Implicit_Base);
-- Process the subtype indication including a validation check on the
diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads
index 057544c..242d561 100644
--- a/gcc/ada/sem_ch6.ads
+++ b/gcc/ada/sem_ch6.ads
@@ -28,9 +28,11 @@ package Sem_Ch6 is
type Conformance_Type is
(Type_Conformant, Mode_Conformant, Subtype_Conformant, Fully_Conformant);
+ pragma Ordered (Conformance_Type);
-- Conformance type used in conformance checks between specs and bodies,
-- and for overriding. The literals match the RM definitions of the
- -- corresponding terms.
+ -- corresponding terms. This is an ordered type, since each conformance
+ -- type is stronger than the ones preceding it.
procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id);
procedure Analyze_Extended_Return_Statement (N : Node_Id);
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 08b0087..44720f0 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -9707,7 +9707,7 @@ package body Sem_Prag is
-- pragma Optimize_Alignment (Time | Space | Off);
- when Pragma_Optimize_Alignment =>
+ when Pragma_Optimize_Alignment => Optimize_Alignment : begin
GNAT_Pragma;
Check_No_Identifiers;
Check_Arg_Count (1);
@@ -9733,6 +9733,42 @@ package body Sem_Prag is
-- switch will get reset anyway at the start of each unit.
Optimize_Alignment_Local := True;
+ end Optimize_Alignment;
+
+ -------------
+ -- Ordered --
+ -------------
+
+ -- pragma Ordered (first_enumeration_subtype_LOCAL_NAME);
+
+ when Pragma_Ordered => Ordered : declare
+ Assoc : constant Node_Id := Arg1;
+ Type_Id : Node_Id;
+ Typ : Entity_Id;
+
+ begin
+ GNAT_Pragma;
+ Check_No_Identifiers;
+ Check_Arg_Count (1);
+ Check_Arg_Is_Local_Name (Arg1);
+
+ Type_Id := Expression (Assoc);
+ Find_Type (Type_Id);
+ Typ := Entity (Type_Id);
+
+ if Typ = Any_Type then
+ return;
+ else
+ Typ := Underlying_Type (Typ);
+ end if;
+
+ if not Is_Enumeration_Type (Typ) then
+ Error_Pragma ("pragma% must specify enumeration type");
+ end if;
+
+ Check_First_Subtype (Arg1);
+ Set_Has_Pragma_Ordered (Base_Type (Typ));
+ end Ordered;
----------
-- Pack --
@@ -9821,7 +9857,7 @@ package body Sem_Prag is
elsif VM_Target = No_VM then
Set_Is_Packed (Base_Type (Typ));
Set_Has_Pragma_Pack (Base_Type (Typ));
- Set_Has_Non_Standard_Rep (Base_Type (Typ));
+ Set_Has_Non_Standard_Rep (Base_Type (Typ));
-- If we ignore the pack, then warn about this, except
-- that we suppress the warning in GNAT mode.
@@ -12818,6 +12854,7 @@ package body Sem_Prag is
Pragma_Obsolescent => 0,
Pragma_Optimize => -1,
Pragma_Optimize_Alignment => -1,
+ Pragma_Ordered => 0,
Pragma_Pack => 0,
Pragma_Page => -1,
Pragma_Passive => -1,
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 78e3811..80b8479 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -91,6 +91,15 @@ package body Sem_Res is
-- Note that Resolve_Attribute is separated off in Sem_Attr
+ function Bad_Unordered_Enumeration_Reference
+ (N : Node_Id;
+ T : Entity_Id) return Boolean;
+ -- Node N contains a potentially dubious reference to type T, either an
+ -- explicit comparison, or an explicit range. This function returns True
+ -- if the type T is an enumeration type for which No pragma Order has been
+ -- given, and the reference N is not in the same extended source unit as
+ -- the declaration of T.
+
procedure Check_Discriminant_Use (N : Node_Id);
-- Enforce the restrictions on the use of discriminants when constraining
-- a component of a discriminated type (record or concurrent type).
@@ -400,6 +409,22 @@ package body Sem_Res is
end if;
end Analyze_And_Resolve;
+ ----------------------------------------
+ -- Bad_Unordered_Enumeration_Reference --
+ ----------------------------------------
+
+ function Bad_Unordered_Enumeration_Reference
+ (N : Node_Id;
+ T : Entity_Id) return Boolean
+ is
+ begin
+ return Is_Enumeration_Type (T)
+ and then Comes_From_Source (N)
+ and then Warn_On_Unordered_Enumeration_Type
+ and then not Has_Pragma_Ordered (T)
+ and then not In_Same_Extended_Unit (N, T);
+ end Bad_Unordered_Enumeration_Reference;
+
----------------------------
-- Check_Discriminant_Use --
----------------------------
@@ -5658,30 +5683,49 @@ package body Sem_Res is
Set_Etype (N, Base_Type (Typ));
Generate_Reference (T, N, ' ');
- if T /= Any_Type then
- if T = Any_String or else
- T = Any_Composite or else
- T = Any_Character
- then
- if T = Any_Character then
- Ambiguous_Character (L);
- else
- Error_Msg_N ("ambiguous operands for comparison", N);
- end if;
+ -- Skip remaining processing if already set to Any_Type
- Set_Etype (N, Any_Type);
- return;
+ if T = Any_Type then
+ return;
+ end if;
+
+ -- Deal with other error cases
+ if T = Any_String or else
+ T = Any_Composite or else
+ T = Any_Character
+ then
+ if T = Any_Character then
+ Ambiguous_Character (L);
else
- Resolve (L, T);
- Resolve (R, T);
- Check_Unset_Reference (L);
- Check_Unset_Reference (R);
- Generate_Operator_Reference (N, T);
- Check_Low_Bound_Tested (N);
- Eval_Relational_Op (N);
+ Error_Msg_N ("ambiguous operands for comparison", N);
end if;
+
+ Set_Etype (N, Any_Type);
+ return;
end if;
+
+ -- Resolve the operands if types OK
+
+ Resolve (L, T);
+ Resolve (R, T);
+ Check_Unset_Reference (L);
+ Check_Unset_Reference (R);
+ Generate_Operator_Reference (N, T);
+ Check_Low_Bound_Tested (N);
+
+ -- Check comparison on unordered enumeration
+
+ if Comes_From_Source (N)
+ and then Bad_Unordered_Enumeration_Reference (N, Etype (L))
+ then
+ Error_Msg_N ("comparison on unordered enumeration type?", N);
+ end if;
+
+ -- Evaluate the relation (note we do this after the above check
+ -- since this Eval call may change N to True/False.
+
+ Eval_Relational_Op (N);
end Resolve_Comparison_Op;
------------------------------------
@@ -7606,13 +7650,56 @@ package body Sem_Res is
L : constant Node_Id := Low_Bound (N);
H : constant Node_Id := High_Bound (N);
+ function First_Last_Ref return Boolean;
+ -- Returns True if N is of the form X'First .. X'Last where X is the
+ -- same entity for both attributes.
+
+ --------------------
+ -- First_Last_Ref --
+ --------------------
+
+ function First_Last_Ref return Boolean is
+ Lorig : constant Node_Id := Original_Node (L);
+ Horig : constant Node_Id := Original_Node (H);
+
+ begin
+ if Nkind (Lorig) = N_Attribute_Reference
+ and then Nkind (Horig) = N_Attribute_Reference
+ and then Attribute_Name (Lorig) = Name_First
+ and then Attribute_Name (Horig) = Name_Last
+ then
+ declare
+ PL : constant Node_Id := Prefix (Lorig);
+ PH : constant Node_Id := Prefix (Horig);
+ begin
+ if Is_Entity_Name (PL)
+ and then Is_Entity_Name (PH)
+ and then Entity (PL) = Entity (PH)
+ then
+ return True;
+ end if;
+ end;
+ end if;
+
+ return False;
+ end First_Last_Ref;
+
+ -- Start of processing for Resolve_Range
+
begin
Set_Etype (N, Typ);
Resolve (L, Typ);
Resolve (H, Typ);
- if Style_Check then
- Check_Enumeration_Subrange (N);
+ -- Check for inappropriate range on unordered enumeration type
+
+ if Bad_Unordered_Enumeration_Reference (N, Typ)
+
+ -- Exclude X'First .. X'Last if X is the same entity for both
+
+ and then not First_Last_Ref
+ then
+ Error_Msg ("subrange of unordered enumeration type?", Sloc (N));
end if;
Check_Unset_Reference (L);
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 95d0826..fc7e344 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -3088,6 +3088,7 @@ package body Sem_Warn is
Warn_On_Redundant_Constructs := True;
Warn_On_Reverse_Bit_Order := True;
Warn_On_Unchecked_Conversion := True;
+ Warn_On_Unordered_Enumeration_Type := True;
Warn_On_Unrecognized_Pragma := True;
Warn_On_Unrepped_Components := True;
Warn_On_Warnings_Off := True;
@@ -3125,6 +3126,12 @@ package body Sem_Warn is
when 'R' =>
Warn_On_Object_Renames_Function := False;
+ when 'u' =>
+ Warn_On_Unordered_Enumeration_Type := True;
+
+ when 'U' =>
+ Warn_On_Unordered_Enumeration_Type := False;
+
when 'v' =>
Warn_On_Reverse_Bit_Order := True;
@@ -3186,6 +3193,7 @@ package body Sem_Warn is
Warn_On_Reverse_Bit_Order := False;
Warn_On_Object_Renames_Function := True;
Warn_On_Unchecked_Conversion := True;
+ Warn_On_Unordered_Enumeration_Type := False;
Warn_On_Unrecognized_Pragma := True;
Warn_On_Unrepped_Components := False;
Warn_On_Warnings_Off := False;
@@ -3256,6 +3264,7 @@ package body Sem_Warn is
Warn_On_Redundant_Constructs := False;
Warn_On_Reverse_Bit_Order := False;
Warn_On_Unchecked_Conversion := False;
+ Warn_On_Unordered_Enumeration_Type := False;
Warn_On_Unrecognized_Pragma := False;
Warn_On_Unrepped_Components := False;
Warn_On_Warnings_Off := False;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 3a9133e..7abd945 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -483,6 +483,7 @@ package Snames is
Name_No_Return : constant Name_Id := N + $; -- Ada 05
Name_Obsolescent : constant Name_Id := N + $; -- GNAT
Name_Optimize : constant Name_Id := N + $;
+ Name_Ordered : constant Name_Id := N + $; -- GNAT
Name_Pack : constant Name_Id := N + $;
Name_Page : constant Name_Id := N + $;
Name_Passive : constant Name_Id := N + $; -- GNAT
@@ -1547,6 +1548,7 @@ package Snames is
Pragma_No_Return,
Pragma_Obsolescent,
Pragma_Optimize,
+ Pragma_Ordered,
Pragma_Pack,
Pragma_Page,
Pragma_Passive,
diff --git a/gcc/ada/style.ads b/gcc/ada/style.ads
index dcade7b..9f9f32a 100644
--- a/gcc/ada/style.ads
+++ b/gcc/ada/style.ads
@@ -103,9 +103,6 @@ package Style is
-- Called after scanning out a binary operator other than a plus, minus
-- or exponentiation operator. Intended for checking spacing rules.
- procedure Check_Enumeration_Subrange (N : Node_Id)
- renames Style_Inst.Check_Enumeration_Subrange;
-
procedure Check_Exponentiation_Operator
renames Style_Inst.Check_Exponentiation_Operator;
-- Called after scanning out an exponentiation operator. Intended for
diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb
index c19a096..dc6b6a6 100644
--- a/gcc/ada/styleg.adb
+++ b/gcc/ada/styleg.adb
@@ -32,13 +32,10 @@ with Casing; use Casing;
with Csets; use Csets;
with Einfo; use Einfo;
with Err_Vars; use Err_Vars;
-with Lib; use Lib;
-with Namet; use Namet;
with Opt; use Opt;
with Scans; use Scans;
with Sinfo; use Sinfo;
with Sinput; use Sinput;
-with Snames; use Snames;
with Stylesw; use Stylesw;
package body Styleg is
@@ -205,6 +202,7 @@ package body Styleg is
end OK_Boolean_Operand;
-- Start of processig for Check_Boolean_Operator
+
begin
if Style_Check_Boolean_And_Or
and then Comes_From_Source (Node)
@@ -553,82 +551,6 @@ package body Styleg is
end if;
end Check_Dot_Dot;
- --------------------------------
- -- Check_Enumeration_Subrange --
- --------------------------------
-
- procedure Check_Enumeration_Subrange (N : Node_Id) is
- function First_Last_Ref return Boolean;
- -- Returns True if N is of the form X'First .. X'Last where X is the
- -- same entity for both attributes. N is already known to be N_Range.
-
- --------------------
- -- First_Last_Ref --
- --------------------
-
- function First_Last_Ref return Boolean is
- L : constant Node_Id := Low_Bound (N);
- H : constant Node_Id := High_Bound (N);
-
- begin
- if Nkind (L) = N_Attribute_Reference
- and then Nkind (H) = N_Attribute_Reference
- and then Attribute_Name (L) = Name_First
- and then Attribute_Name (H) = Name_Last
- then
- declare
- PL : constant Node_Id := Prefix (L);
- PH : constant Node_Id := Prefix (H);
- begin
- if Is_Entity_Name (PL)
- and then Is_Entity_Name (PH)
- and then Entity (PL) = Entity (PH)
- then
- return True;
- end if;
- end;
- end if;
-
- return False;
- end First_Last_Ref;
-
- -- Start of processing for Check_Enumeration_Subrange
-
- begin
- if Style_Check_Enumeration_Subranges then
-
- if Nkind (N) = N_Range
-
- -- Only consider ranges that are explicit in the source
-
- and then Comes_From_Source (N)
-
- -- Only consider enumeration types
-
- and then Is_Enumeration_Type (Etype (N))
-
- -- Exclude standard types. Most importantly we want to exclude the
- -- standard character types, since we want to allow ranges like
- -- '0' .. '9'. But also exclude Boolean since False .. True is OK.
-
- and then Sloc (Root_Type (Etype (N))) /= Standard_Location
-
- -- Exclude X'First .. X'Last if X is the same entity for both
-
- and then not First_Last_Ref
-
- -- Allow the range if in same unit as type declaration (or the
- -- corresponding body or any of its subunits).
-
- and then not In_Same_Extended_Unit (N, Etype (N))
- then
- Error_Msg
- ("(style) explicit enumeration subrange not allowed",
- Sloc (N));
- end if;
- end if;
- end Check_Enumeration_Subrange;
-
---------------
-- Check_EOF --
---------------
diff --git a/gcc/ada/styleg.ads b/gcc/ada/styleg.ads
index ea78f6e..954a033 100644
--- a/gcc/ada/styleg.ads
+++ b/gcc/ada/styleg.ads
@@ -92,10 +92,6 @@ package Styleg is
procedure Check_Dot_Dot;
-- Called after scanning out dot dot to check spacing
- procedure Check_Enumeration_Subrange (N : Node_Id);
- -- Called to check a node that may be an N_Range node for an enumeration
- -- subtype occurring other than in the defining unit of the type.
-
procedure Check_EOF;
-- Called after scanning out EOF mark
diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb
index 7d3c5ce..9a59996 100644
--- a/gcc/ada/stylesw.adb
+++ b/gcc/ada/stylesw.adb
@@ -63,7 +63,6 @@ package body Stylesw is
-- not yet have the whole tool suite clean with respect to this.
-- "B" & -- check boolean operators
- -- "E" & -- check enumeration ranges
-------------------------------
-- Reset_Style_Check_Options --
@@ -79,7 +78,6 @@ package body Stylesw is
Style_Check_Boolean_And_Or := False;
Style_Check_Comments := False;
Style_Check_DOS_Line_Terminator := False;
- Style_Check_Enumeration_Subranges := False;
Style_Check_End_Labels := False;
Style_Check_Form_Feeds := False;
Style_Check_Horizontal_Tabs := False;
@@ -165,7 +163,6 @@ package body Stylesw is
Add ('c', Style_Check_Comments);
Add ('d', Style_Check_DOS_Line_Terminator);
Add ('e', Style_Check_End_Labels);
- Add ('E', Style_Check_Enumeration_Subranges);
Add ('f', Style_Check_Form_Feeds);
Add ('h', Style_Check_Horizontal_Tabs);
Add ('i', Style_Check_If_Then_Layout);
@@ -332,9 +329,6 @@ package body Stylesw is
when 'e' =>
Style_Check_End_Labels := True;
- when 'E' =>
- Style_Check_Enumeration_Subranges := True;
-
when 'f' =>
Style_Check_Form_Feeds := True;
@@ -499,9 +493,6 @@ package body Stylesw is
when 'e' =>
Style_Check_End_Labels := False;
- when 'E' =>
- Style_Check_Enumeration_Subranges := False;
-
when 'f' =>
Style_Check_Form_Feeds := False;
diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads
index 7d5a461..f7d45b6 100644
--- a/gcc/ada/stylesw.ads
+++ b/gcc/ada/stylesw.ads
@@ -113,12 +113,6 @@ package Stylesw is
-- This can be set True by using the -gnatye switch. If it is True, then
-- optional END labels must always be present.
- Style_Check_Enumeration_Subranges : Boolean := False;
- -- This can be set True by using the -gnatyE switch. If it is True, then
- -- explicit subranges (using .. notation) on enumeration subtypes are not
- -- permitted in other than the same source unit in which the enumeration
- -- subtype is declared.
-
Style_Check_Form_Feeds : Boolean := False;
-- This can be set True by using the -gnatyf switch. If it is True, then
-- form feeds and vertical tabs are not allowed in the source text.
diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words
index efa5356..b202a34 100644
--- a/gcc/ada/ug_words
+++ b/gcc/ada/ug_words
@@ -170,6 +170,8 @@ gcc -c ^ GNAT COMPILE
-gnatwT ^ /WARNINGS=NODELETED_CODE
-gnatwu ^ /WARNINGS=UNUSED
-gnatwU ^ /WARNINGS=NOUNUSED
+-gnatw.u ^ /WARNINGS=UNORDERED_ENUMERATIONS
+-gnatw.U ^ /WARNINGS=NOUNORDERED_ENUMERATIONS
-gnatwv ^ /WARNINGS=VARIABLES_UNINITIALIZED
-gnatwV ^ /WARNINGS=NOVARIABLES_UNINITIALIZED
-gnatww ^ /WARNINGS=LOWBOUND_ASSUMED
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 1bd22b5..c0b7ce6 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -470,6 +470,8 @@ begin
Write_Line (" T* turn off warnings for tracking deleted code");
Write_Line (" u+ turn on warnings for unused entity");
Write_Line (" U* turn off warnings for unused entity");
+ Write_Line (" .u turn on warnings for unordered enumeration");
+ Write_Line (" .U* turn off warnings for unordered enumeration");
Write_Line (" v*+ turn on warnings for unassigned variable");
Write_Line (" V turn off warnings for unassigned variable");
Write_Line (" .v*+ turn on info messages for reverse bit order");
@@ -533,7 +535,6 @@ begin
Write_Line (" c check comment format");
Write_Line (" d check no DOS line terminators");
Write_Line (" e check end/exit labels present");
- Write_Line (" E check no explicit enumeration subranges");
Write_Line (" f check no form feeds/vertical tabs in source");
Write_Line (" g check standard GNAT style rules");
Write_Line (" h check no horizontal tabs in source");
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 5477dea..ba15a27 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -2277,10 +2277,6 @@ package VMS_Data is
"-gnatye " &
"NOEND " &
"-gnaty-e " &
- "ENUMERATION_RANGES " &
- "-gnatyE " &
- "NOENUMERATION_RANGES " &
- "-gnaty-E " &
"VTABS " &
"-gnatyf " &
"NOVTABS " &
@@ -3005,6 +3001,10 @@ package VMS_Data is
"-gnatwu " &
"NOUNUSED " &
"-gnatwU " &
+ "UNORDERED_ENUMERATIONS " &
+ "-gnatw.u " &
+ "NOUNORDERED_ENUMERATIONS " &
+ "-gnatw.U " &
"VARIABLES_UNINITIALIZED " &
"-gnatwv " &
"NOVARIABLES_UNINITIALIZED " &