From 308aab0bb643f5237eb0bfc6c7134a35907a33a9 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 20 Feb 2014 14:54:18 +0100 Subject: [PATCH] [multiple changes] 2014-02-20 Vincent Celier * gnatcmd.adb, make.adb, prj-makr.adb, clean.adb: Call Stringt.Initialize in all project aware tools. 2014-02-20 Doug Rupp * gnat_ugn.texi: Document gnatbind -X option. * vms_data.ads: Minor warnings documentation reformatting. 2014-02-20 Ed Schonberg * exp_ch3.adb (Expand_Freeze_Array_Type): Only create invariant procedure for a base type. 2014-02-20 Robert Dewar * sem_ch4.adb (Analyze_Case_Expression): Get type from first expression with type info. * sem_ch13.adb: Minor reformatting. * sem_eval.adb (Subtypes_Statically_Match): Make sure we return False if predicates do not match on the two types. 2014-02-20 Arnaud Charlet * sem_prag.adb (Analyze_Pragma [pragma Attach_Handler]): In Relaxed_RM_Semantics mode, allow any static integer value, for compatibility with other compilers. From-SVN: r207948 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/clean.adb | 2 ++ gcc/ada/exp_ch3.adb | 4 +++- gcc/ada/gnat_ugn.texi | 10 ++++++++++ gcc/ada/gnatcmd.adb | 2 ++ gcc/ada/make.adb | 2 ++ gcc/ada/prj-makr.adb | 2 ++ gcc/ada/sem_ch13.adb | 2 +- gcc/ada/sem_ch4.adb | 14 +++++++++++++- gcc/ada/sem_eval.adb | 12 ++++++++---- gcc/ada/sem_prag.adb | 37 +++++++++++++++++++++++++------------ gcc/ada/vms_data.ads | 30 +++++++++++++++--------------- 12 files changed, 112 insertions(+), 34 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 998272e..13a2d01 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,34 @@ 2014-02-20 Vincent Celier + * gnatcmd.adb, make.adb, prj-makr.adb, clean.adb: Call + Stringt.Initialize in all project aware tools. + +2014-02-20 Doug Rupp + + * gnat_ugn.texi: Document gnatbind -X option. + * vms_data.ads: Minor warnings documentation reformatting. + +2014-02-20 Ed Schonberg + + * exp_ch3.adb (Expand_Freeze_Array_Type): Only create invariant + procedure for a base type. + +2014-02-20 Robert Dewar + + * sem_ch4.adb (Analyze_Case_Expression): Get type from first + expression with type info. + * sem_ch13.adb: Minor reformatting. + * sem_eval.adb (Subtypes_Statically_Match): Make sure we return + False if predicates do not match on the two types. + +2014-02-20 Arnaud Charlet + + * sem_prag.adb (Analyze_Pragma [pragma Attach_Handler]): + In Relaxed_RM_Semantics mode, allow any static integer value, + for compatibility with other compilers. + +2014-02-20 Vincent Celier + * errutil.adb (Initialize): Properly initialize entry in table Warnings when warnings are suppressed. diff --git a/gcc/ada/clean.adb b/gcc/ada/clean.adb index 83e81cb..49e3a5b 100644 --- a/gcc/ada/clean.adb +++ b/gcc/ada/clean.adb @@ -39,6 +39,7 @@ with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; with Sdefault; with Snames; +with Stringt; with Switch; use Switch; with Table; with Targparm; use Targparm; @@ -1559,6 +1560,7 @@ package body Clean is Csets.Initialize; Snames.Initialize; + Stringt.Initialize; Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 6cd4636..6934363 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -6076,13 +6076,15 @@ package body Exp_Ch3 is end if; if Has_Invariants (Component_Type (Base)) + and then Typ = Base and then In_Open_Scopes (Scope (Component_Type (Base))) then -- Generate component invariant checking procedure. This is only -- relevant if the array type is within the scope of the component -- type. Otherwise an array object can only be built using the public -- subprograms for the component type, and calls to those will have - -- invariant checks. + -- invariant checks. The invariant procedure is only generated for + -- a base type, not a subtype. Insert_Component_Invariant_Checks (N, Base, Build_Array_Invariant_Proc (Base, N)); diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b61254d..51efc05 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -8484,6 +8484,16 @@ Default mode, in which sources are checked for consistency only if they are available. @end ifset +@item ^-X@var{nnn}^/RETURN_CODES=POSIX^ +@cindex @option{^-X@var{nnn}^/RETURN_CODES=POSIX^} (@code{gnatbind}) +Set default exit status value, normally 0 for POSIX compliance. + +@ifset vms +@item /RETURN_CODES=VMS +@cindex @option{/RETURN_CODES=VMS} (@code{gnatbind}) +VMS default normal successful return value is 1. +@end ifset + @item ^-y^/ENABLE_LEAP_SECONDS^ @cindex @option{^-y^/ENABLE_LEAP_SECONDS^} (@code{gnatbind}) Enable leap seconds support in @code{Ada.Calendar} and its children. diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 5d8a935..494fd4d 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -44,6 +44,7 @@ with Prj.Util; use Prj.Util; with Sdefault; with Sinput.P; with Snames; use Snames; +with Stringt; with Table; with Targparm; with Tempdir; @@ -1392,6 +1393,7 @@ begin Csets.Initialize; Snames.Initialize; + Stringt.Initialize; Prj.Tree.Initialize (Root_Environment, Gnatmake_Flags); diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index 5078f0e..e8acb4e 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -55,6 +55,7 @@ with Sdefault; with SFN_Scan; with Sinput.P; with Snames; use Snames; +with Stringt; pragma Warnings (Off); with System.HTable; @@ -6411,6 +6412,7 @@ package body Make is Csets.Initialize; Snames.Initialize; + Stringt.Initialize; Prj.Initialize (Project_Tree); diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index f6d71f4..4f4ab43 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -38,6 +38,7 @@ with Prj.Tree; use Prj.Tree; with Prj.Util; use Prj.Util; with Sdefault; with Snames; use Snames; +with Stringt; with Table; use Table; with Tempdir; @@ -804,6 +805,7 @@ package body Prj.Makr is Csets.Initialize; Snames.Initialize; + Stringt.Initialize; Prj.Initialize (No_Project_Tree); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 79ca903..4c85bfa 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -86,7 +86,7 @@ package body Sem_Ch13 is -- size value. In this case, we reset the Alignment to unknown. procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id); - -- If Typ has predicates (indicated by Has_Predicates being set for Typ, + -- If Typ has predicates (indicated by Has_Predicates being set for Typ), -- then either there are pragma Predicate entries on the rep chain for the -- type (note that Predicate aspects are converted to pragma Predicate), or -- there are inherited aspects from a parent type, or ancestor subtypes. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 8f93ad3..12fffbd 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1356,11 +1356,15 @@ package body Sem_Ch4 is -- Local variables Expr : constant Node_Id := Expression (N); - FirstX : constant Node_Id := Expression (First (Alternatives (N))); Alt : Node_Id; Exp_Type : Entity_Id; Exp_Btype : Entity_Id; + FirstX : Node_Id := Empty; + -- First expression in the case for which there is some type information + -- available, i.e. it is not Any_Type, which can happen because of some + -- error, or from the use of e.g. raise Constraint_Error. + Others_Present : Boolean; -- Indicates if Others was present @@ -1379,9 +1383,17 @@ package body Sem_Ch4 is Alt := First (Alternatives (N)); while Present (Alt) loop Analyze (Expression (Alt)); + + if No (FirstX) and then Etype (Expression (Alt)) /= Any_Type then + FirstX := Expression (Alt); + end if; + Next (Alt); end loop; + -- Get our initial type from the first expression for which we got some + -- useful type information from the expression. + if not Is_Overloaded (FirstX) then Set_Etype (N, Etype (FirstX)); diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 629ce45..7857d80 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -4901,6 +4901,11 @@ package body Sem_Eval is then return False; + -- No match if predicates do not match + + elsif not Predicates_Match then + return False; + -- Scalar types elsif Is_Scalar_Type (T1) then @@ -4955,7 +4960,7 @@ package body Sem_Eval is return True; end if; - -- Otherwise both types have bound that can be compared + -- Otherwise both types have bounds that can be compared declare LB1 : constant Node_Id := Type_Low_Bound (T1); @@ -4964,11 +4969,10 @@ package body Sem_Eval is HB2 : constant Node_Id := Type_High_Bound (T2); begin - -- If the bounds are the same tree node, then match if and only - -- if any predicates present also match. + -- If the bounds are the same tree node, then match (common case) if LB1 = LB2 and then HB1 = HB2 then - return Predicates_Match; + return True; -- Otherwise bounds must be static and identical value diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d011760..eb1dbd1 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11545,19 +11545,32 @@ package body Sem_Prag is -- be expanded in the init proc. If expansion is enabled, then -- perform semantic checks on a copy only. - if Expander_Active then - declare - Temp : constant Node_Id := - New_Copy_Tree (Get_Pragma_Arg (Arg2)); - begin - Set_Parent (Temp, N); - Preanalyze_And_Resolve (Temp, RTE (RE_Interrupt_ID)); - end; + declare + Temp : Node_Id; + Typ : Node_Id; + Parg2 : constant Node_Id := Get_Pragma_Arg (Arg2); - else - Analyze (Get_Pragma_Arg (Arg2)); - Resolve (Get_Pragma_Arg (Arg2), RTE (RE_Interrupt_ID)); - end if; + begin + -- In Relaxed_RM_Semantics mode, we allow any static + -- integer value, for compatibility with other compilers. + + if Relaxed_RM_Semantics + and then Nkind (Parg2) = N_Integer_Literal + then + Typ := Standard_Integer; + else + Typ := RTE (RE_Interrupt_ID); + end if; + + if Expander_Active then + Temp := New_Copy_Tree (Parg2); + Set_Parent (Temp, N); + Preanalyze_And_Resolve (Temp, Typ); + else + Analyze (Parg2); + Resolve (Parg2, Typ); + end if; + end; Process_Interrupt_Or_Attach_Handler; end if; diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index 166948d..e6cacd8 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -3345,7 +3345,7 @@ package VMS_Data is -- qualifier with a value other than NONE (in -- other words, this option is effective only -- if optimization is turned on). - + -- -- ERRORS Warning messages are to be treated as errors. -- The warning string still appears, but the -- warning messages are counted as errors, and @@ -3389,7 +3389,7 @@ package VMS_Data is -- access to an atomic variable requires the -- generation of atomic synchronization code. -- - -- AVOID_GAPS Activate warnings for gaps in records. + -- AVOIDGAPS Activate warnings for gaps in records. -- (-gnatw.h) This outputs a warning if a representation -- clause for a record leaves unallocated bits. -- @@ -3408,6 +3408,10 @@ package VMS_Data is -- (-gnatwc) in tests where the expression is known to -- be True or False at compile time. -- + -- CONSTANT_VARIABLES Activate warnings on constant variables. + -- (-gnatwk) A warning is output for a variable which could + -- have been declared as a constant. + -- -- DELETED_CODE Activate warning for conditional deleted code. -- (-gnatwt) This option generates warnings for tracking of -- code in conditionals (IF and CASE statements) @@ -3416,10 +3420,6 @@ package VMS_Data is -- front end. This may be useful for detecting -- deactivated code in certified applications. -- - -- CONSTANT_VARIABLES Activate warnings on constant variables. - -- (-gnatwk) A warning is output for a variable which could - -- have been declared as a constant. - -- -- ELABORATION Activate warnings on missing pragma Elaborate -- (-gnatwl) and Elaborate_All statements. -- @@ -3433,15 +3433,6 @@ package VMS_Data is -- an entity with the same name as some other -- entity that is directly or use-visible. -- - -- IMPORT_EXPORT_PRAGMAS Activate warnings on import-export pragmas. - -- (-gnatwx) This generates a warning on an Export or Import - -- pragma when the compiler detects a possible - -- conflict between the Ada and foreign language - -- calling sequences. For example, the use of - -- default parameters in a convention C procedure - -- is dubious because the C compiler cannot supply - -- the proper default, so a warning is issued. - -- -- IMPLEMENTATION Activate warnings for a with of an internal -- (-gnatwi) GNAT implementation unit, defined as any unit -- from the Ada, Interfaces, GNAT, DEC or System @@ -3461,6 +3452,15 @@ package VMS_Data is -- checks occur only at points where the source -- program contains an explicit use of .all. -- + -- IMPORT_EXPORT_PRAGMAS Activate warnings on import-export pragmas. + -- (-gnatwx) This generates a warning on an Export or Import + -- pragma when the compiler detects a possible + -- conflict between the Ada and foreign language + -- calling sequences. For example, the use of + -- default parameters in a convention C procedure + -- is dubious because the C compiler cannot supply + -- the proper default, so a warning is issued. + -- -- INEFFECTIVE_INLINE Activate warnings on ineffective Inlines. -- (-gnatwp) Activates warnings for failure of front end -- inlining (activated by /INLINE=FULL) to -- 2.7.4