2015-05-12 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 12 May 2015 09:28:19 +0000 (09:28 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 12 May 2015 09:28:19 +0000 (09:28 +0000)
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223053 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/checks.adb
gcc/ada/checks.ads
gcc/ada/einfo.ads
gcc/ada/exp_intr.adb
gcc/ada/exp_unst.adb
gcc/ada/sem_ch9.adb
gcc/ada/sem_disp.adb
gcc/ada/sem_prag.adb

index 87c3372..7a90775 100644 (file)
@@ -1,3 +1,15 @@
+2015-05-12  Robert Dewar  <dewar@adacore.com>
+
+       * 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  <schonberg@adacore.com>
 
        * sem_ch9.adb (Collect_Interfaces): Initialize
index e869605..b2e779c 100644 (file)
@@ -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
index 24e5e6d..5375eed 100644 (file)
@@ -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
index c48b637..d752a1e 100644 (file)
@@ -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.
index 7e68600..8002fef 100644 (file)
@@ -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;
index ec99e07..a857259 100644 (file)
@@ -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
index 0e1af32..ff11231 100644 (file)
@@ -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);
 
index dfb0122..4bc21f7 100644 (file)
@@ -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
index f3f10cd..ede7685 100644 (file)
@@ -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