diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 87c3372e997..7a90775fc20 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2015-05-12 Robert Dewar + + * sem_ch9.adb, einfo.ads, exp_intr.adb: Minor reformatting. + * sem_disp.adb: Minor code reorganization (remove junk redundant + null statement). + * exp_unst.adb (Unnest_Subprogram.Uplev_Refs): Ignore uplevel + references to bounds of types coming from original type reference. + * checks.ads: Minor reformatting. + * checks.adb: Minor reformatting. + * sem_prag.adb (Analyze_Pragma, case Check): If in ignored + assertion, then make sure we do not drag in bignum stuff. + 2015-05-12 Ed Schonberg * sem_ch9.adb (Collect_Interfaces): Initialize diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index e869605c2de..b2e779c99e6 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -7789,9 +7789,9 @@ package body Checks is Analyze_And_Resolve (N, Typ); - Scope_Suppress.Suppress (Overflow_Check) := Svo; - Scope_Suppress.Overflow_Mode_General := Svg; - Scope_Suppress.Overflow_Mode_Assertions := Sva; + Scope_Suppress.Suppress (Overflow_Check) := Svo; + Scope_Suppress.Overflow_Mode_General := Svg; + Scope_Suppress.Overflow_Mode_Assertions := Sva; end Reanalyze; -------------- @@ -7817,9 +7817,9 @@ package body Checks is Expand (N); - Scope_Suppress.Suppress (Overflow_Check) := Svo; - Scope_Suppress.Overflow_Mode_General := Svg; - Scope_Suppress.Overflow_Mode_Assertions := Sva; + Scope_Suppress.Suppress (Overflow_Check) := Svo; + Scope_Suppress.Overflow_Mode_General := Svg; + Scope_Suppress.Overflow_Mode_Assertions := Sva; end Reexpand; -- Start of processing for Minimize_Eliminate_Overflows diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 24e5e6d9cd8..5375eed48a2 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, 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- -- @@ -81,11 +81,11 @@ package Checks is function Overflow_Check_Mode return Overflow_Mode_Type; -- Returns current overflow checking mode, taking into account whether - -- we are inside an assertion expression. + -- we are inside an assertion expression and the assertion policy. - ------------------------------------------ - -- Control of Alignment Check Warnings -- - ------------------------------------------ + ----------------------------------------- + -- Control of Alignment Check Warnings -- + ----------------------------------------- -- When we have address clauses, there is an issue of whether the address -- specified is appropriate to the alignment. In the general case where the diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c48b63759e9..d752a1ed5aa 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -882,6 +882,7 @@ package Einfo is -- primitives that come from source must be stored in this list in the -- order of their occurrence in the sources. For incomplete types the -- list is always empty. +-- -- When expansion is disabled the corresponding record type of a -- synchronized type is not constructed. In that case, such types -- carry this attribute directly, for ASIS use. @@ -2017,7 +2018,7 @@ package Einfo is -- Defined in all entities. Indicates that the entity is locally defined -- within a subprogram P, and there is a reference to the entity within -- a subprogram nested within P (at any depth). Set only for the VM case --- (where it is set for variables, constants and loop parameters). Note +-- (where it is set for variables, constants, and loop parameters). Note -- that this is similar in usage to Is_Uplevel_Referenced_Entity (which -- is used when we are unnesting subprograms), but the usages are a bit -- different and it is cleaner to leave the old VM usage unchanged. diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 7e68600a980..8002fef8bc9 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -359,8 +359,8 @@ package body Exp_Intr is Parameter_Associations => New_List ( Relocate_Node (Tag_Arg), New_Occurrence_Of - (Node (First_Elmt (Access_Disp_Table - (Etype (Act_Constr)))), + (Node (First_Elmt + (Access_Disp_Table (Etype (Act_Constr)))), Loc)))); Insert_Action (N, Iface_Tag); end; diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index ec99e07d2a4..a85725971af 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -1428,6 +1428,16 @@ package body Exp_Unst is goto Continue; end if; + -- Also ignore uplevel references to bounds of types that come + -- from the original type reference. + + if Is_Entity_Name (UPJ.Ref) + and then Present (Entity (UPJ.Ref)) + and then Is_Type (Entity (UPJ.Ref)) + then + goto Continue; + end if; + -- Rewrite one reference Rewrite_One_Ref : declare diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 0e1af32c678..ff112317080 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -3225,10 +3225,10 @@ package body Sem_Ch9 is if Present (Interface_List (N)) then Set_Is_Tagged_Type (T); - -- The primitive operations of a tagged synchronized type are - -- placed on the Corresponding_Record for proper dispatching, - -- but are attached to the synchronized type itself when - -- expansion is disabled, for ASIS use. + -- The primitive operations of a tagged synchronized type are placed + -- on the Corresponding_Record for proper dispatching, but are + -- attached to the synchronized type itself when expansion is + -- disabled, for ASIS use. Set_Direct_Primitive_Operations (T, New_Elmt_List); diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index dfb01226019..4bc21f778d5 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -1335,11 +1335,10 @@ package body Sem_Disp is elsif Is_Concurrent_Type (Tagged_Type) then pragma Assert (not Expander_Active); - -- Attach operation to list of primitives of the synchronized - -- type itself, for ASIS use. + -- Attach operation to list of primitives of the synchronized type + -- itself, for ASIS use. Append_Elmt (Subp, Direct_Primitive_Operations (Tagged_Type)); - null; -- If no old subprogram, then we add this as a dispatching operation, -- but we avoid doing this if an error was posted, to prevent annoying diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index f3f10cd1917..ede76850ad7 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11373,7 +11373,7 @@ package body Sem_Prag is end case; -- Check applicable policy. We skip this if Checked/Ignored status - -- is already set (e.g. in the casse of a pragma from an aspect). + -- is already set (e.g. in the case of a pragma from an aspect). if Is_Checked (N) or else Is_Ignored (N) then null; @@ -11441,7 +11441,7 @@ package body Sem_Prag is end if; end case; - -- Deal with analyzing the string argument. + -- Deal with analyzing the string argument if Arg_Count = 3 then @@ -11495,10 +11495,38 @@ package body Sem_Prag is Left_Opnd => Make_Identifier (Eloc, Name_False), Right_Opnd => Expr), Then_Statements => New_List ( - Make_Null_Statement (Eloc)))); + Make_Null_Statement (Eloc)))); + + -- Now go ahead and analyze the if statement In_Assertion_Expr := In_Assertion_Expr + 1; - Analyze (N); + + -- One rather special treatment. If we are now in Eliminated + -- overflow mode, then suppress overflow checking since we do + -- not want to drag in the bignum stuff if we are in Ignore + -- mode anyway. This is particularly important if we are using + -- a configurable run time that does not support bignum ops. + + if Scope_Suppress.Overflow_Mode_Assertions = Eliminated then + declare + Svo : constant Boolean := + Scope_Suppress.Suppress (Overflow_Check); + begin + Scope_Suppress.Overflow_Mode_Assertions := Strict; + Scope_Suppress.Suppress (Overflow_Check) := True; + Analyze (N); + Scope_Suppress.Suppress (Overflow_Check) := Svo; + Scope_Suppress.Overflow_Mode_Assertions := Eliminated; + end; + + -- Not that special case! + + else + Analyze (N); + end if; + + -- All done with this check + In_Assertion_Expr := In_Assertion_Expr - 1; -- Check is active or expansion not active. In these cases we can