[Ada] Do not suppress checks in instances of internal generics

This patch removes suppression of checks in nested instances of internal
packages. No test.

This was inconsistent: only for packages, not for subprograms. Only for
nested instantiations, not library level ones. Not for GNAT units.

Furthermore, the user should have control via pragma Suppress or
switches.

Furthermore, without this change, there could be missing tampering
checks in Ada.Containers.

2019-08-12  Bob Duff  <duff@adacore.com>

gcc/ada/

	* sem_ch12.adb (Instantiate_Package_Body): Remove suppression of
	checks in instances of internal units.
	* sem_ch6.adb (Analyze_Function_Return): Do not generate a
	constraint check on an extended_return_statement if the subtype
	of the return object in the statement is identical to the return
	subtype of the function.

From-SVN: r274302

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4922e46ff54a0be6adc39a240ef0cedad68debda..f2870e8dbc0dd1302ffb58f1902800947aba744a 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2019-08-12  Bob Duff  <duff@adacore.com>
+
+       * sem_ch12.adb (Instantiate_Package_Body): Remove suppression of
+       checks in instances of internal units.
+       * sem_ch6.adb (Analyze_Function_Return): Do not generate a
+       constraint check on an extended_return_statement if the subtype
+       of the return object in the statement is identical to the return
+       subtype of the function.
+
 2019-08-12  Bob Duff  <duff@adacore.com>
 
        * libgnat/a-cbmutr.adb (Is_Reachable): Declare Idx to be of the

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 3aa49755b39fcaa4f210284464ffaaaf8c874a93..1f3a397e6e40ed764256846921ef78801d6dab2c 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -11601,25 +11601,7 @@ package body Sem_Ch12 is
             --  indicate that the body instance is to be delayed.
 
             Install_Body (Act_Body, Inst_Node, Gen_Body, Gen_Decl);
-
-            --  Now analyze the body. We turn off all checks if this is an
-            --  internal unit, since there is no reason to have checks on for
-            --  any predefined run-time library code. All such code is designed
-            --  to be compiled with checks off.
-
-            --  Note that we do NOT apply this criterion to children of GNAT
-            --  The latter units must suppress checks explicitly if needed.
-
-            --  We also do not suppress checks in CodePeer mode where we are
-            --  interested in finding possible runtime errors.
-
-            if not CodePeer_Mode
-              and then In_Predefined_Unit (Gen_Decl)
-            then
-               Analyze (Act_Body, Suppress => All_Checks);
-            else
-               Analyze (Act_Body);
-            end if;
+            Analyze (Act_Body);
          end if;
 
          Inherit_Context (Gen_Body, Inst_Node);

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 3c026bf43b993afde6f91c7c855d6fc806e9ec48..e176535dec63c53a7fabb27afd468929c2ce54a5 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1056,9 +1056,17 @@ package body Sem_Ch6 is
          --  Apply constraint check. Note that this is done before the implicit
          --  conversion of the expression done for anonymous access types to
          --  ensure correct generation of the null-excluding check associated
-         --  with null-excluding expressions found in return statements.
-
-         Apply_Constraint_Check (Expr, R_Type);
+         --  with null-excluding expressions found in return statements. We
+         --  don't need a check if the subtype of the return object is the
+         --  same as the result subtype of the function.
+
+         if Nkind (N) /= N_Extended_Return_Statement
+           or else Nkind (Obj_Decl) /= N_Object_Declaration
+           or else Nkind (Object_Definition (Obj_Decl)) not in N_Has_Entity
+           or else Entity (Object_Definition (Obj_Decl)) /= R_Type
+         then
+            Apply_Constraint_Check (Expr, R_Type);
+         end if;
 
          --  The return value is converted to the return type of the function,
          --  which implies a predicate check if the return type is predicated.