2011-08-01 Ed Schonberg <schonberg@adacore.com>

	* sem_ch6.adb (Fully_Conformant_Expressions): handle quantified
	expressions.

2011-08-01  Arnaud Charlet  <charlet@adacore.com>

	* sem_ch8.adb: Minor code editing.
	* s-vxwext.adb: Remove trailing space.
	* freeze.adb, freeze.ads, errout.ads, erroutc.adb: Fix GPLv3 header for
	consistency with other files.

2011-08-01  Thomas Quinot  <quinot@adacore.com>

	* s-auxdec.ads, s-auxdec-vms_64.ads: Minor reformatting.

2011-08-01  Ed Schonberg  <schonberg@adacore.com>

	* par-ch10.adb: reject parameterized expressions as compilation unit.
	* sem_ch4.adb: handle properly conditional expression with overloaded
	then_clause and no else_clause.

2011-08-01  Tristan Gingold  <gingold@adacore.com>

	* s-parame-vms-alpha.ads, s-parame-vms-ia64.ads: Redeclare C_Address
	like done by System.Aux_DEC.
	* env.c (__gnat_setenv) [VMS]: Put logicals into LNM$PROCESS table.



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

15 files changed, 151 insertions, 78 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 868af9bb1df..b3e29a1a847 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,31 @@
+2011-08-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Fully_Conformant_Expressions): handle quantified
+	expressions.
+
+2011-08-01  Arnaud Charlet  <charlet@adacore.com>
+
+	* sem_ch8.adb: Minor code editing.
+	* s-vxwext.adb: Remove trailing space.
+	* freeze.adb, freeze.ads, errout.ads, erroutc.adb: Fix GPLv3 header for
+	consistency with other files.
+
+2011-08-01  Thomas Quinot  <quinot@adacore.com>
+
+	* s-auxdec.ads, s-auxdec-vms_64.ads: Minor reformatting.
+
+2011-08-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* par-ch10.adb: reject parameterized expressions as compilation unit.
+	* sem_ch4.adb: handle properly conditional expression with overloaded
+	then_clause and no else_clause.
+
+2011-08-01  Tristan Gingold  <gingold@adacore.com>
+
+	* s-parame-vms-alpha.ads, s-parame-vms-ia64.ads: Redeclare C_Address
+	like done by System.Aux_DEC.
+	* env.c (__gnat_setenv) [VMS]: Put logicals into LNM$PROCESS table.
+
 2011-08-01  Yannick Moy  <moy@adacore.com>
 
 	* par-endh.adb (Check_End): issue a syntax error in SPARK mode for
diff --git a/gcc/ada/env.c b/gcc/ada/env.c
index e83a051921b..dc18e4e6a21 100644
--- a/gcc/ada/env.c
+++ b/gcc/ada/env.c
@@ -111,8 +111,7 @@ __gnat_setenv (char *name, char *value)
 {
 #if defined (VMS)
   struct dsc$descriptor_s name_desc;
-  /* Put in JOB table for now, so that the project stuff at least works.  */
-  $DESCRIPTOR (table_desc, "LNM$JOB");
+  $DESCRIPTOR (table_desc, "LNM$PROCESS");
   char *host_pathspec = value;
   char *copy_pathspec;
   int num_dirs_in_pathspec = 1;
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index ea2600aa318..e9ddb7e3e87 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -13,11 +13,10 @@
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- You should have received a copy of the GNU General Public License along  --
--- with this program; see file COPYING3.  If not see                        --
--- <http://www.gnu.org/licenses/>.                                          --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index e023f317440..4c450f61084 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -13,11 +13,10 @@
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- You should have received a copy of the GNU General Public License along  --
--- with this program; see file COPYING3.  If not see                        --
--- <http://www.gnu.org/licenses/>.                                          --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 3ecc13e6432..c84468536de 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -13,11 +13,10 @@
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- You should have received a copy of the GNU General Public License along  --
--- with this program; see file COPYING3.  If not see                        --
--- <http://www.gnu.org/licenses/>.                                          --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff --git a/gcc/ada/freeze.ads b/gcc/ada/freeze.ads
index d4dd1a1251b..5ecce680736 100644
--- a/gcc/ada/freeze.ads
+++ b/gcc/ada/freeze.ads
@@ -13,11 +13,10 @@
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
---                                                                          --
--- You should have received a copy of the GNU General Public License along  --
--- with this program; see file COPYING3.  If not see                        --
--- <http://www.gnu.org/licenses/>.                                          --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license.          --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb
index d3c1c162ec9..47e4fdb7d7e 100644
--- a/gcc/ada/par-ch10.adb
+++ b/gcc/ada/par-ch10.adb
@@ -563,6 +563,11 @@ package body Ch10 is
          then
             Name_Node := Defining_Unit_Name (Unit_Node);
 
+         elsif Nkind (Unit_Node) = N_Parameterized_Expression then
+            Error_Msg_SP
+              ("parameterized expression cannot be used as compilation unit");
+            return Comp_Unit_Node;
+
          --  Anything else is a serious error, abandon scan
 
          else
diff --git a/gcc/ada/s-auxdec-vms_64.ads b/gcc/ada/s-auxdec-vms_64.ads
index 202cdbc9857..ea0720dfdb4 100644
--- a/gcc/ada/s-auxdec-vms_64.ads
+++ b/gcc/ada/s-auxdec-vms_64.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2010, 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- --
@@ -285,9 +285,9 @@ package System.Aux_DEC is
    pragma Import (Intrinsic, Import_Address);
    pragma Import (Intrinsic, Import_Largest_Value);
 
-   --  For the following declarations, note that the declaration without
-   --  a Retry_Count parameter means to retry infinitely. A value of zero
-   --  for the Retry_Count parameter means do not retry.
+   --  For the following declarations, note that the declaration without a
+   --  Retry_Count parameter means to retry infinitely. A value of zero for
+   --  the Retry_Count parameter means do not retry.
 
    --  Interlocked-instruction procedures
 
@@ -303,8 +303,7 @@ package System.Aux_DEC is
       Value : Short_Integer;
    end record;
 
-   for Aligned_Word'Alignment use
-     Integer'Min (2, Standard'Maximum_Alignment);
+   for Aligned_Word'Alignment use Integer'Min (2, Standard'Maximum_Alignment);
 
    procedure Clear_Interlocked
      (Bit          : in out Boolean;
@@ -337,9 +336,9 @@ package System.Aux_DEC is
    for Aligned_Long_Integer'Alignment use
      Integer'Min (8, Standard'Maximum_Alignment);
 
-   --  For the following declarations, note that the declaration without
-   --  a Retry_Count parameter mean to retry infinitely. A value of zero
-   --  for the Retry_Count means do not retry.
+   --  For the following declarations, note that the declaration without a
+   --  Retry_Count parameter mean to retry infinitely. A value of zero for
+   --  the Retry_Count means do not retry.
 
    procedure Add_Atomic
      (To           : in out Aligned_Integer;
@@ -407,12 +406,11 @@ package System.Aux_DEC is
       Old_Value    : out Long_Integer;
       Success_Flag : out Boolean);
 
-   type Insq_Status is
-     (Fail_No_Lock, OK_Not_First, OK_First);
+   type Insq_Status is (Fail_No_Lock, OK_Not_First, OK_First);
 
    for Insq_Status use
      (Fail_No_Lock => -1,
-      OK_Not_First => 0,
+      OK_Not_First =>  0,
       OK_First     => +1);
 
    type Remq_Status is (
@@ -423,7 +421,7 @@ package System.Aux_DEC is
 
    for Remq_Status use
      (Fail_No_Lock   => -1,
-      Fail_Was_Empty => 0,
+      Fail_Was_Empty =>  0,
       OK_Not_Empty   => +1,
       OK_Empty       => +2);
 
@@ -453,7 +451,7 @@ private
    No_Addr      : constant Address := Null_Address;
 
    --  An AST_Handler value is from a typing point of view simply a pointer
-   --  to a procedure taking a single 64bit parameter. However, this
+   --  to a procedure taking a single 64 bit parameter. However, this
    --  is a bit misleading, because the data that this pointer references is
    --  highly stylized. See body of System.AST_Handling for full details.
 
diff --git a/gcc/ada/s-auxdec.ads b/gcc/ada/s-auxdec.ads
index 4b56bafffc4..53937aa9889 100644
--- a/gcc/ada/s-auxdec.ads
+++ b/gcc/ada/s-auxdec.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1996-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1996-2010, 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- --
@@ -41,14 +41,13 @@ package System.Aux_DEC is
    pragma Preelaborate;
 
    subtype Short_Address is Address;
-   --  In some versions of System.Aux_DEC, notably that for VMS on the
-   --  ia64, there are two address types (64-bit and 32-bit), and the
-   --  name Short_Address is used for the short address form. To avoid
-   --  difficulties (in regression tests and elsewhere) with units that
-   --  reference Short_Address, it is provided for other targets as a
-   --  synonym for the normal Address type, and, as in the case where
-   --  the lengths are different, Address and Short_Address can be
-   --  freely inter-converted.
+   --  In some versions of System.Aux_DEC, notably that for VMS on IA64, there
+   --  are two address types (64-bit and 32-bit), and the name Short_Address
+   --  is used for the short address form. To avoid difficulties (in regression
+   --  tests and elsewhere) with units that reference Short_Address, it is
+   --  provided for other targets as a synonym for the normal Address type,
+   --  and, as in the case where the lengths are different, Address and
+   --  Short_Address can be freely inter-converted.
 
    type Integer_8  is range -2 **  (8 - 1) .. +2 **  (8 - 1) - 1;
    for Integer_8'Size  use  8;
@@ -272,9 +271,9 @@ package System.Aux_DEC is
    pragma Import (Intrinsic, Import_Address);
    pragma Import (Intrinsic, Import_Largest_Value);
 
-   --  For the following declarations, note that the declaration without
-   --  a Retry_Count parameter means to retry infinitely. A value of zero
-   --  for the Retry_Count parameter means do not retry.
+   --  For the following declarations, note that the declaration without a
+   --  Retry_Count parameter means to retry infinitely. A value of zero for
+   --  the Retry_Count parameter means do not retry.
 
    --  Interlocked-instruction procedures
 
@@ -290,8 +289,7 @@ package System.Aux_DEC is
       Value : Short_Integer;
    end record;
 
-   for Aligned_Word'Alignment use
-     Integer'Min (2, Standard'Maximum_Alignment);
+   for Aligned_Word'Alignment use Integer'Min (2, Standard'Maximum_Alignment);
 
    procedure Clear_Interlocked
      (Bit          : in out Boolean;
@@ -324,9 +322,9 @@ package System.Aux_DEC is
    for Aligned_Long_Integer'Alignment use
      Integer'Min (8, Standard'Maximum_Alignment);
 
-   --  For the following declarations, note that the declaration without
-   --  a Retry_Count parameter mean to retry infinitely. A value of zero
-   --  for the Retry_Count means do not retry.
+   --  For the following declarations, note that the declaration without a
+   --  Retry_Count parameter mean to retry infinitely. A value of zero for
+   --  the Retry_Count means do not retry.
 
    procedure Add_Atomic
      (To           : in out Aligned_Integer;
@@ -394,12 +392,11 @@ package System.Aux_DEC is
       Old_Value    : out Long_Integer;
       Success_Flag : out Boolean);
 
-   type Insq_Status is
-     (Fail_No_Lock, OK_Not_First, OK_First);
+   type Insq_Status is (Fail_No_Lock, OK_Not_First, OK_First);
 
    for Insq_Status use
      (Fail_No_Lock => -1,
-      OK_Not_First => 0,
+      OK_Not_First =>  0,
       OK_First     => +1);
 
    type Remq_Status is (
@@ -410,7 +407,7 @@ package System.Aux_DEC is
 
    for Remq_Status use
      (Fail_No_Lock   => -1,
-      Fail_Was_Empty => 0,
+      Fail_Was_Empty =>  0,
       OK_Not_Empty   => +1,
       OK_Empty       => +2);
 
@@ -440,7 +437,7 @@ private
    No_Addr      : constant Address := Null_Address;
 
    --  An AST_Handler value is from a typing point of view simply a pointer
-   --  to a procedure taking a single 64bit parameter. However, this
+   --  to a procedure taking a single 64 bit parameter. However, this
    --  is a bit misleading, because the data that this pointer references is
    --  highly stylized. See body of System.AST_Handling for full details.
 
diff --git a/gcc/ada/s-parame-vms-alpha.ads b/gcc/ada/s-parame-vms-alpha.ads
index 308656c1415..7799dc1e8b8 100644
--- a/gcc/ada/s-parame-vms-alpha.ads
+++ b/gcc/ada/s-parame-vms-alpha.ads
@@ -46,8 +46,6 @@
 --  Note: do not introduce any pragma Inline statements into this unit, since
 --  otherwise the relinking and rebinding capability would be deactivated.
 
-with System.Aux_DEC;
-
 package System.Parameters is
    pragma Pure;
 
@@ -113,10 +111,13 @@ package System.Parameters is
    --  of all targets. For example, in OpenVMS long /= Long_Integer.
 
    ptr_bits  : constant := 32;
-   subtype C_Address is System.Short_Address;
-   --  Number of bits in Interaces.C pointers, normally a standard address,
+   subtype C_Address is System.Address
+     range -2 ** (ptr_bits - 1) .. 2 ** (ptr_bits - 1) - 1;
+   for C_Address'Object_Size use ptr_bits;
+   --  Number of bits in Interfaces.C pointers, normally a standard address,
    --  except on 64-bit VMS where they are 32-bit addresses, for compatibility
-   --  with legacy code.
+   --  with legacy code. System.Aux_DEC.Short_Address can't be used because of
+   --  elaboration circularity.
 
    C_Malloc_Linkname : constant String := "__gnat_malloc32";
    --  Name of runtime function used to allocate such a pointer
diff --git a/gcc/ada/s-parame-vms-ia64.ads b/gcc/ada/s-parame-vms-ia64.ads
index 29ec8088843..89c49ba7bea 100644
--- a/gcc/ada/s-parame-vms-ia64.ads
+++ b/gcc/ada/s-parame-vms-ia64.ads
@@ -46,8 +46,6 @@
 --  Note: do not introduce any pragma Inline statements into this unit, since
 --  otherwise the relinking and rebinding capability would be deactivated.
 
-with System.Aux_DEC;
-
 package System.Parameters is
    pragma Pure;
 
@@ -113,10 +111,14 @@ package System.Parameters is
    --  of all targets. For example, in OpenVMS long /= Long_Integer.
 
    ptr_bits  : constant := 32;
-   subtype C_Address is System.Short_Address;
+   subtype C_Address is System.Address
+     range -2 ** (ptr_bits - 1) .. 2 ** (ptr_bits - 1) - 1;
+   for C_Address'Object_Size use ptr_bits;
    --  Number of bits in Interaces.C pointers, normally a standard address,
    --  except on 64-bit VMS where they are 32-bit addresses, for compatibility
    --  with legacy code.
+   --  System.Aux_DEC.Short_Address can't be used because of elaboration
+   --  circularity.
 
    C_Malloc_Linkname : constant String := "__gnat_malloc32";
    --  Name of runtime function used to allocate such a pointer
diff --git a/gcc/ada/s-vxwext.adb b/gcc/ada/s-vxwext.adb
index 9964b104dfd..cfc65da62b6 100644
--- a/gcc/ada/s-vxwext.adb
+++ b/gcc/ada/s-vxwext.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   B o d y                                --
 --                                                                          --
---           Copyright (C) 2009-2010, Free Software Foundation, Inc.        --  
+--           Copyright (C) 2009-2010, 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- --
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 2a3b840cee1..76a308dd06f 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -1495,19 +1495,23 @@ package body Sem_Ch4 is
          begin
             Set_Etype (N, Any_Type);
             Get_First_Interp (Then_Expr, I, It);
-            while Present (It.Nam) loop
+            if No (Else_Expr) then
+               --  if no else_expression the conditional must be boolean.
 
-               --  For each possible interpretation of the Then Expression,
-               --  add it only if the else expression has a compatible type.
+               Set_Etype (N, Standard_Boolean);
+            else
+               while Present (It.Nam) loop
 
-               --  Is this right if Else_Expr is empty?
+                  --  For each possible intepretation of the Then Expression,
+                  --  add it only if the else expression has a compatible type.
 
-               if Has_Compatible_Type (Else_Expr, It.Typ) then
-                  Add_One_Interp (N, It.Typ, It.Typ);
-               end if;
+                  if Has_Compatible_Type (Else_Expr, It.Typ) then
+                     Add_One_Interp (N, It.Typ, It.Typ);
+                  end if;
 
-               Get_Next_Interp (I, It);
-            end loop;
+                  Get_Next_Interp (I, It);
+               end loop;
+            end if;
          end;
       end if;
    end Analyze_Conditional_Expression;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 8e2e2793ffc..a49f9973917 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6685,6 +6685,50 @@ package body Sem_Ch6 is
                    and then
                  FCE (Expression (E1), Expression (E2));
 
+            when N_Quantified_Expression =>
+               if not FCE (Condition (E1), Condition (E2)) then
+                  return False;
+               end if;
+
+               if Present (Loop_Parameter_Specification (E1))
+                 and then Present (Loop_Parameter_Specification (E2))
+               then
+                  declare
+                     L1 : constant Node_Id :=
+                       Loop_Parameter_Specification (E1);
+                     L2 : constant Node_Id :=
+                       Loop_Parameter_Specification (E2);
+
+                  begin
+                     return
+                       Reverse_Present (L1) = Reverse_Present (L2)
+                         and then
+                           FCE (Defining_Identifier (L1),
+                                Defining_Identifier (L2))
+                         and then
+                           FCE (Discrete_Subtype_Definition (L1),
+                                Discrete_Subtype_Definition (L2));
+                  end;
+
+               else   --  quantified expression with an iterator
+                  declare
+                     I1 : constant Node_Id := Iterator_Specification (E1);
+                     I2 : constant Node_Id := Iterator_Specification (E2);
+
+                  begin
+                     return
+                       FCE (Defining_Identifier (I1),
+                            Defining_Identifier (I2))
+                       and then
+                         Of_Present (I1) = Of_Present (I2)
+                       and then
+                         Reverse_Present (I1) = Reverse_Present (I2)
+                       and then FCE (Name (I1), Name (I2))
+                       and then FCE (Subtype_Indication (I1),
+                                      Subtype_Indication (I2));
+                  end;
+               end if;
+
             when N_Range =>
                return
                  FCE (Low_Bound (E1), Low_Bound (E2))
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 56f57d177a5..852888c17d3 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6299,8 +6299,7 @@ package body Sem_Ch8 is
          pragma Assert (not Scope_Stack.Table (J).Is_Active_Stack_Base);
       end loop;
 
-      pragma Assert (False);  --  unreachable
-      raise Program_Error;
+      raise Program_Error;    --  unreachable
    end Has_Loop_In_Inner_Open_Scopes;
 
    --------------------