exp_ch4.adb (In_Range_Chec)): New predicate, subsidiary of Expand_N_In...
authorEd Schonberg <schonberg@adacore.com>
Wed, 22 Jun 2016 09:48:49 +0000 (09:48 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 22 Jun 2016 09:48:49 +0000 (11:48 +0200)
2016-06-22  Ed Schonberg  <schonberg@adacore.com>

* exp_ch4.adb (In_Range_Chec)): New predicate, subsidiary of
Expand_N_In: within an expanded range check that might raise
Constraint_Error do not generate a predicate check as well. It
is redundant because the context will add an explicit predicate
check, and it will raise the wrong exception if it fails.
* lib-xref-spark_specific.adb (Add_SPARK_File): Remove useless checks
since dependency units always have an associated compilation unit.

From-SVN: r237683

gcc/ada/ChangeLog
gcc/ada/exp_ch4.adb
gcc/ada/lib-xref-spark_specific.adb

index 851424db2ab39415a0c045cdb6cfa82fec0d24bd..5703832c6f5651722a64c3e62a53254f4e4d9224 100644 (file)
@@ -1,3 +1,13 @@
+2016-06-22  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_ch4.adb (In_Range_Chec)): New predicate, subsidiary of
+       Expand_N_In: within an expanded range check that might raise
+       Constraint_Error do not generate a predicate check as well. It
+       is redundant because the context will add an explicit predicate
+       check, and it will raise the wrong exception if it fails.
+       * lib-xref-spark_specific.adb (Add_SPARK_File): Remove useless checks
+       since dependency units always have an associated compilation unit.
+
 2016-06-22  Arnaud Charlet  <charlet@adacore.com>
 
        * lib.ads: Code cleanup.
index 36f3ecc1b00101442c046d79ab1c4e8d2d7bc9f0..1cdfa1ac880ea7b7298235258b31d0f63dab4975 100644 (file)
@@ -6107,18 +6107,60 @@ package body Exp_Ch4 is
       --  (the check is only done when the right operand is a subtype; see
       --  RM12-4.5.2 (28.1/3-30/3)).
 
-      declare
+      Predicate_Check : declare
+         function In_Range_Check return Boolean;
+         --  Within an expanded range check that may raise Constraint_Error do
+         --  not generate a predicate check as well. It is redundant because
+         --  the context will add an explicit predicate check, and it will
+         --  raise the wrong exception if it fails.
+
+         --------------------
+         -- In_Range_Check --
+         --------------------
+
+         function In_Range_Check return Boolean is
+            P : Node_Id;
+         begin
+            P := Parent (N);
+            while Present (P) loop
+               if Nkind (P) = N_Raise_Constraint_Error then
+                  return True;
+
+               elsif Nkind (P) in N_Statement_Other_Than_Procedure_Call
+                 or else Nkind (P) = N_Procedure_Call_Statement
+                 or else Nkind (P) in N_Declaration
+               then
+                  return False;
+               end if;
+
+               P := Parent (P);
+            end loop;
+
+            return False;
+         end In_Range_Check;
+
+         --  Local variables
+
          PFunc : constant Entity_Id := Predicate_Function (Rtyp);
+         R_Op  : Node_Id;
+
+      --  Start of processing for Predicate_Check
 
       begin
          if Present (PFunc)
            and then Current_Scope /= PFunc
            and then Nkind (Rop) /= N_Range
          then
+            if not In_Range_Check then
+               R_Op := Make_Predicate_Call (Rtyp, Lop, Mem => True);
+            else
+               R_Op := New_Occurrence_Of (Standard_True, Loc);
+            end if;
+
             Rewrite (N,
               Make_And_Then (Loc,
                 Left_Opnd  => Relocate_Node (N),
-                Right_Opnd => Make_Predicate_Call (Rtyp, Lop, Mem => True)));
+                Right_Opnd => R_Op));
 
             --  Analyze new expression, mark left operand as analyzed to
             --  avoid infinite recursion adding predicate calls. Similarly,
@@ -6131,7 +6173,7 @@ package body Exp_Ch4 is
 
             return;
          end if;
-      end;
+      end Predicate_Check;
    end Expand_N_In;
 
    --------------------------------
index 7e131f02e27d0a0d5e3130ef1e4c4d54ed6f4e79..062e50c262289c883ed3010e5ffa17a6bf306f84 100644 (file)
@@ -153,35 +153,26 @@ package body SPARK_Specific is
       --  Subunits are traversed as part of the top-level unit to which they
       --  belong.
 
-      if Present (Cunit (Ubody))
-        and then Nkind (Unit (Cunit (Ubody))) = N_Subunit
-      then
+      if Nkind (Unit (Cunit (Ubody))) = N_Subunit then
          return;
       end if;
 
       From := SPARK_Scope_Table.Last + 1;
 
-      --  Unit might not have an associated compilation unit, as seen in code
-      --  filling Sdep_Table in Write_ALI.
-
-      if Present (Cunit (Ubody)) then
-         Traverse_Compilation_Unit
-           (CU           => Cunit (Ubody),
-            Process      => Detect_And_Add_SPARK_Scope'Access,
-            Inside_Stubs => True);
-      end if;
+      Traverse_Compilation_Unit
+        (CU           => Cunit (Ubody),
+         Process      => Detect_And_Add_SPARK_Scope'Access,
+         Inside_Stubs => True);
 
       --  When two units are present for the same compilation unit, as it
       --  happens for library-level instantiations of generics, then add all
       --  scopes to the same SPARK file.
 
       if Ubody /= Uspec then
-         if Present (Cunit (Uspec)) then
-            Traverse_Compilation_Unit
-              (CU           => Cunit (Uspec),
-               Process      => Detect_And_Add_SPARK_Scope'Access,
-               Inside_Stubs => True);
-         end if;
+         Traverse_Compilation_Unit
+           (CU           => Cunit (Uspec),
+            Process      => Detect_And_Add_SPARK_Scope'Access,
+            Inside_Stubs => True);
       end if;
 
       --  Update scope numbers
@@ -209,8 +200,7 @@ package body SPARK_Specific is
       --  For subunits, also retrieve the file name of the unit. Only do so if
       --  unit has an associated compilation unit.
 
-      if Present (Cunit (Uspec))
-        and then Present (Cunit (Unit (File)))
+      if Present (Cunit (Unit (File)))
         and then Nkind (Unit (Cunit (Unit (File)))) = N_Subunit
       then
          Get_Name_String (Reference_Name (Main_Source_File));