diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 45 | ||||
| -rw-r--r-- | gcc/ada/cstand.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 15 | ||||
| -rw-r--r-- | gcc/ada/g-calend.ads | 13 | ||||
| -rw-r--r-- | gcc/ada/g-pehage.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 96 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 25 | ||||
| -rw-r--r-- | gcc/ada/opt.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/osint.adb | 21 | ||||
| -rw-r--r-- | gcc/ada/par-prag.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/s-ficobl.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-taskin.ads | 41 | ||||
| -rw-r--r-- | gcc/ada/s-tasren.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/s-tpobop.adb | 36 | ||||
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 129 | ||||
| -rw-r--r-- | gcc/ada/sem_warn.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/snames.ads-tmpl | 2 | ||||
| -rw-r--r-- | gcc/ada/style.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/styleg.adb | 80 | ||||
| -rw-r--r-- | gcc/ada/styleg.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/stylesw.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/stylesw.ads | 6 | ||||
| -rw-r--r-- | gcc/ada/ug_words | 2 | ||||
| -rw-r--r-- | gcc/ada/usage.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/vms_data.ads | 8 |
30 files changed, 436 insertions, 216 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8f4232310ce..54bd5d9fa36 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 9f9332b7241..bc85f0c5044 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 21320afaa77..231089548c2 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 3dd0a5cd82e..7a396c75ad1 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 39ca20371a0..9dd5ae00a84 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 b59e1ecec98..1b480182441 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 e4a39e1671b..933978e444b 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 76d555a7132..3d5eaf31471 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 6f0b6d96688..4107b0c56bf 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 5ecf7fa615a..f4f879fec9d 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 a421592ad84..acc941e5eb6 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 f58ae6cb040..c8f6bc66207 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 185fc52cff9..2142e49024c 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 0cc43f38680..104a3a68c24 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 35e0dd37d63..1ea6699473e 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 13688e6c669..f9ca610a060 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 7708b8b37c8..c926e096066 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 057544cd1a5..242d5615c55 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 08b0087a6cd..44720f02cff 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 78e3811c1ce..80b8479e24a 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 95d08269317..fc7e3440b60 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 3a9133e732e..7abd945de0a 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 dcade7ba86f..9f9f32a932d 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 c19a0969c51..dc6b6a64892 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 ea78f6ed473..954a0335996 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 7d3c5cef613..9a599965587 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 7d5a461ded9..f7d45b6d60c 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 efa5356dff3..b202a34fe36 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 1bd22b5045c..c0b7ce6aa1a 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 5477dea1bd3..ba15a27e49b 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 " & |