lib.adb, [...]: Minor reformatting and code reorganization.

2009-07-13  Robert Dewar  <dewar@adacore.com>

	* lib.adb, prj-nmsc.adb, prj-proc.adb, prj-proc.ads, prj.adb,
	prj.ads: Minor reformatting and code reorganization.

	* par-ch3.adb (Check_Restricted_Expression): New procedure

From-SVN: r149566

8 files changed, 140 insertions, 91 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 03680cca..c71282e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2009-07-13  Robert Dewar  <dewar@adacore.com>
+
+	* lib.adb, prj-nmsc.adb, prj-proc.adb, prj-proc.ads, prj.adb,
+	prj.ads: Minor reformatting and code reorganization.
+
+	* par-ch3.adb (Check_Restricted_Expression): New procedure
+
 2009-07-13  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_attr.adb (Rewrite_Stream_Proc_Call): When rewriting a stream
diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb
index 802506b..63dd620 100644
--- a/gcc/ada/lib.adb
+++ b/gcc/ada/lib.adb
@@ -605,13 +605,15 @@ package body Lib is
       --  If not in the table, must be a spec created for a main unit that is a
       --  child subprogram body which we have not inserted into the table yet.
 
-      if N /= Library_Unit (Cunit (Main_Unit)) then
-         --  We do not use a pragma Assert here, since this would not be
-         --  enabled in case assertions are not active.
+      if N = Library_Unit (Cunit (Main_Unit)) then
+         return Main_Unit;
+
+      --  If it is anything else, something is seriously wrong, and we really
+      --  don't want to proceed, even if assertions are off, so we explicitly
+      --  raise an exception in this case to terminate compilation.
 
-         raise Program_Error;
       else
-         return Main_Unit;
+         raise Program_Error;
       end if;
    end Get_Cunit_Unit_Number;
 
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index 820cb55..1b26833 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -31,6 +31,10 @@ with Sinfo.CN; use Sinfo.CN;
 
 separate (Par)
 
+---------
+-- Ch3 --
+---------
+
 package body Ch3 is
 
    -----------------------
@@ -55,6 +59,24 @@ package body Ch3 is
    function P_Variant                                      return Node_Id;
    function P_Variant_Part                                 return Node_Id;
 
+   procedure Check_Restricted_Expression (N : Node_Id);
+   --  Check that the expression N meets the Restricted_Expression syntax.
+   --  The syntax is as follows:
+   --
+   --    RESTRICTED_EXPRESSION ::=
+   --        RESTRICTED_RELATION {and RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {and then RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {or RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {or else RESTRICTED_RELATION}
+   --      | RESTRICTED_RELATION {xor RESTRICTED_RELATION}
+   --
+   --    RESTRICTED_RELATION ::=
+   --       SIMPLE_EXPRESSION [RELATIONAL_OPERATOR SIMPLE_EXPRESSION]
+   --
+   --  This syntax is used for choices when extensions (and set notations)
+   --  are enabled, to remove the ambiguity of "when X in A | B". We consider
+   --  it very unlikely that this will ever arise in practice.
+
    procedure P_Declarative_Items
      (Decls   : List_Id;
       Done    : out Boolean;
@@ -89,6 +111,27 @@ package body Ch3 is
    --  current token, and if this is the first such message issued, saves
    --  the message id in Missing_Begin_Msg, for possible later replacement.
 
+
+   ---------------------------------
+   -- Check_Restricted_Expression --
+   ---------------------------------
+
+   procedure Check_Restricted_Expression (N : Node_Id) is
+   begin
+      if Nkind_In (N, N_Op_And, N_Op_Or, N_Op_Xor, N_And_Then, N_Or_Else) then
+         Check_Restricted_Expression (Left_Opnd (N));
+         Check_Restricted_Expression (Right_Opnd (N));
+
+      elsif Nkind_In (N, N_In, N_Not_In)
+        and then Paren_Count (N) = 0
+      then
+         Error_Msg_N
+           ("|this expression must be parenthesized!", N);
+         Error_Msg_N
+           ("\|since extensions (and set notation) are allowed", N);
+      end if;
+   end Check_Restricted_Expression;
+
    -------------------
    -- Init_Expr_Opt --
    -------------------
@@ -3630,22 +3673,16 @@ package body Ch3 is
                   --     when (A in 1 .. 10 | 12) =>
                   --     when (A in 1 .. 10) | 12 =>
 
-                  --  We consider it unlikely that reintroducing the Ada 83
-                  --  restriction will cause an upwards incompatibility issue.
-                  --  Historically the only reason for the change in Ada 95 was
-                  --  for consistency (all cases of Simple_Expression in Ada 83
-                  --  which could be changed to Expression without causing any
-                  --  ambiguities were changed).
-
-                  if Extensions_Allowed and then Expr_Form = EF_Non_Simple then
-                     Error_Msg_N
-                       ("|this expression must be parenthesized!",
-                        Expr_Node);
-                     Error_Msg_N
-                       ("\|since extensions (and set notation) are allowed",
-                        Expr_Node);
+                  --  To solve this, if extensins are enabled, we disallow
+                  --  the use of membership operations in expressions in
+                  --  choices. Technically in the grammar, the expression
+                  --  must match the grammar for restricted expression.
+
+                  if Extensions_Allowed then
+                     Check_Restricted_Expression (Expr_Node);
 
                   --  In Ada 83 mode, the syntax required a simple expression
+
                   else
                      Check_Simple_Expression_In_Ada_83 (Expr_Node);
                   end if;
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 2609dff..3940e6c 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -143,7 +143,7 @@ package body Prj.Nmsc is
       Hash       => Hash,
       Equal      => "=");
    --  Mapping from base file names to Source_Id (containing full info about
-   --  the source)
+   --  the source).
 
    type Tree_Processing_Data is record
       Tree           : Project_Tree_Ref;
@@ -937,9 +937,8 @@ package body Prj.Nmsc is
                   --  are sources for which this is an alternate language.
 
                   if Language.First_Source = No_Source
-                    and then
-                      (Data.Flags.Require_Sources_Other_Lang
-                       or else Language.Name = Name_Ada)
+                    and then (Data.Flags.Require_Sources_Other_Lang
+                               or else Language.Name = Name_Ada)
                   then
                      Iter := For_Each_Source (In_Tree => Data.Tree,
                                               Project => Project);
@@ -4315,12 +4314,11 @@ package body Prj.Nmsc is
                        and then not UData.File_Names (Impl).Locally_Removed
                      then
                         if Check_Project
-                          (UData.File_Names (Impl).Project,
-                           Project, Extending)
+                             (UData.File_Names (Impl).Project,
+                              Project, Extending)
                         then
-                           --  There is a body for this unit. If there is
-                           --  no spec, we need to check that it is not a
-                           --  subunit.
+                           --  There is a body for this unit. If there is no
+                           --  spec, we need to check that it is not a subunit.
 
                            if UData.File_Names (Spec) = null then
                               declare
@@ -4333,7 +4331,7 @@ package body Prj.Nmsc is
                                       (Impl).Path.Name));
 
                                  if Sinput.P.Source_File_Is_Subunit
-                                   (Src_Ind)
+                                      (Src_Ind)
                                  then
                                     Error_Msg
                                       (Project,
@@ -4347,11 +4345,10 @@ package body Prj.Nmsc is
                               end;
                            end if;
 
-                           --  The unit is not a subunit, so we add the
-                           --  ALI file for its body to the Interface ALIs.
+                           --  The unit is not a subunit, so we add the ALI
+                           --  file for its body to the Interface ALIs.
 
-                           Add_ALI_For
-                             (UData.File_Names (Impl).File);
+                           Add_ALI_For (UData.File_Names (Impl).File);
 
                         else
                            Error_Msg
@@ -4365,16 +4362,15 @@ package body Prj.Nmsc is
                        and then UData.File_Names (Spec) /= null
                        and then not UData.File_Names (Spec).Locally_Removed
                        and then Check_Project
-                         (UData.File_Names (Spec).Project,
-                          Project, Extending)
+                                  (UData.File_Names (Spec).Project,
+                                   Project, Extending)
 
                      then
                         --  The unit is part of the project, it has a spec,
                         --  but no body. We add the ALI for its spec to the
                         --  Interface ALIs.
 
-                        Add_ALI_For
-                          (UData.File_Names (Spec).File);
+                        Add_ALI_For (UData.File_Names (Spec).File);
 
                      else
                         Error_Msg
@@ -4391,7 +4387,7 @@ package body Prj.Nmsc is
                         while Prj.Element (Iter) /= No_Source
                           and then
                             (Prj.Element (Iter).Unit = null
-                              or else Prj.Element (Iter).Unit.Name /= Unit)
+                               or else Prj.Element (Iter).Unit.Name /= Unit)
                         loop
                            Next (Iter);
                         end loop;
@@ -4407,7 +4403,6 @@ package body Prj.Nmsc is
                      if Source /= No_Source then
                         if Source.Kind = Sep then
                            Source := No_Source;
-
                         elsif Source.Kind = Spec
                           and then Other_Part (Source) /= No_Source
                         then
@@ -4437,6 +4432,8 @@ package body Prj.Nmsc is
                            Source := Other_Part (Source);
                         end if;
 
+                        --  Can't we use Append here???
+
                         String_Element_Table.Increment_Last
                           (Data.Tree.String_Elements);
 
@@ -4456,13 +4453,10 @@ package body Prj.Nmsc is
                           String_Element_Table.Last
                             (Data.Tree.String_Elements);
                      end if;
-
                   end if;
-
                end if;
 
-               Interfaces :=
-                 Data.Tree.String_Elements.Table (Interfaces).Next;
+               Interfaces := Data.Tree.String_Elements.Table (Interfaces).Next;
             end loop;
 
             --  Put the list of Interface ALIs in the project data
@@ -4575,7 +4569,7 @@ package body Prj.Nmsc is
                         --  Report error if it is one of the source directories
 
                         if Project.Library_Src_Dir.Name =
-                          Path_Name_Type (Src_Dir.Value)
+                             Path_Name_Type (Src_Dir.Value)
                         then
                            Error_Msg
                              (Project,
@@ -4604,7 +4598,7 @@ package body Prj.Nmsc is
                                 Data.Tree.String_Elements.Table (Src_Dirs);
 
                               --  Report error if it is one of the source
-                              --  directories
+                              --  directories.
 
                               if Project.Library_Src_Dir.Name =
                                 Path_Name_Type (Src_Dir.Value)
@@ -4852,7 +4846,8 @@ package body Prj.Nmsc is
    begin
       if Dir'Length > 1
         and then (Dir (Dir'Last - 1) = Directory_Separator
-                   or else Dir (Dir'Last - 1) = '/')
+                    or else
+                  Dir (Dir'Last - 1) = '/')
       then
          return Dir'Last - 1;
       else
@@ -5120,8 +5115,8 @@ package body Prj.Nmsc is
             The_Path : constant String :=
                          Normalize_Pathname
                            (Get_Name_String (Path),
-                            Directory     => Get_Name_String
-                              (Project.Directory.Display_Name),
+                            Directory     =>
+                              Get_Name_String (Project.Directory.Display_Name),
                             Resolve_Links => Opt.Follow_Links_For_Dirs) &
                          Directory_Separator;
 
@@ -6746,7 +6741,8 @@ package body Prj.Nmsc is
    procedure Initialize
      (Data  : out Tree_Processing_Data;
       Tree  : Project_Tree_Ref;
-      Flags : Prj.Processing_Flags) is
+      Flags : Prj.Processing_Flags)
+   is
    begin
       Files_Htable.Reset (Data.File_To_Source);
       Data.Tree  := Tree;
@@ -6768,7 +6764,8 @@ package body Prj.Nmsc is
 
    procedure Initialize
      (Data    : in out Project_Processing_Data;
-      Project : Project_Id) is
+      Project : Project_Id)
+   is
    begin
       Data.Project := Project;
    end Initialize;
@@ -7473,8 +7470,9 @@ package body Prj.Nmsc is
                         else
                            --  Check if it is a subunit
 
-                           Src_Ind := Sinput.P.Load_Project_File
-                             (Get_Name_String (Src_Id.Path.Name));
+                           Src_Ind :=
+                             Sinput.P.Load_Project_File
+                               (Get_Name_String (Src_Id.Path.Name));
 
                            if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
                               Override_Kind (Src_Id, Sep);
@@ -7661,7 +7659,8 @@ package body Prj.Nmsc is
 
       procedure Recursive_Check
         (Project : Project_Id;
-         Data    : in out Tree_Processing_Data) is
+         Data    : in out Tree_Processing_Data)
+      is
       begin
          if Verbose_Mode then
             Write_Str ("Processing_Naming_Scheme for project """);
@@ -7676,6 +7675,8 @@ package body Prj.Nmsc is
         For_Every_Project_Imported (Tree_Processing_Data, Recursive_Check);
 
       Data : Tree_Processing_Data;
+
+   --  Start of processing for Process_Naming_Scheme
    begin
       Initialize (Data, Tree => Tree, Flags => Flags);
       Check_All_Projects (Root_Project, Data, Imported_First => True);
diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb
index dbf6441..7c553af 100644
--- a/gcc/ada/prj-proc.adb
+++ b/gcc/ada/prj-proc.adb
@@ -77,9 +77,9 @@ package body Prj.Proc is
    --  the package or project with declarations Decl.
 
    procedure Check
-     (In_Tree                    : Project_Tree_Ref;
-      Project                    : Project_Id;
-      Flags                      : Processing_Flags);
+     (In_Tree : Project_Tree_Ref;
+      Project : Project_Id;
+      Flags   : Processing_Flags);
    --  Set all projects to not checked, then call Recursive_Check for the
    --  main project Project. Project is set to No_Project if errors occurred.
    --  Current_Dir is for optimization purposes, avoiding extra system calls.
@@ -264,9 +264,9 @@ package body Prj.Proc is
    -----------
 
    procedure Check
-     (In_Tree                    : Project_Tree_Ref;
-      Project                    : Project_Id;
-      Flags                      : Processing_Flags)
+     (In_Tree : Project_Tree_Ref;
+      Project : Project_Id;
+      Flags   : Processing_Flags)
    is
    begin
       Process_Naming_Scheme (In_Tree, Project, Flags);
@@ -293,7 +293,6 @@ package body Prj.Proc is
 
                if Source2 = No_Source then
                   Unit_Htable.Set (K => Name, E => Source1);
-
                else
                   Unit_Htable.Remove (Name);
                end if;
@@ -355,7 +354,6 @@ package body Prj.Proc is
          if To.Attributes = No_Variable then
             To.Attributes :=
               Variable_Element_Table.Last (In_Tree.Variable_Elements);
-
          else
             In_Tree.Variable_Elements.Table (V2).Next :=
               Variable_Element_Table.Last (In_Tree.Variable_Elements);
@@ -388,7 +386,6 @@ package body Prj.Proc is
 
             if To.Arrays = No_Array then
                To.Arrays := Array_Table.Last (In_Tree.Arrays);
-
             else
                In_Tree.Arrays.Table (A2).Next :=
                  Array_Table.Last (In_Tree.Arrays);
@@ -453,7 +450,7 @@ package body Prj.Proc is
       First_Term             : Project_Node_Id;
       Kind                   : Variable_Kind) return Variable_Value
    is
-      The_Term : Project_Node_Id := First_Term;
+      The_Term : Project_Node_Id;
       --  The term in the expression list
 
       The_Current_Term : Project_Node_Id := Empty_Node;
@@ -471,6 +468,7 @@ package body Prj.Proc is
 
       --  Process each term of the expression, starting with First_Term
 
+      The_Term := First_Term;
       while Present (The_Term) loop
          The_Current_Term := Current_Term (The_Term, From_Project_Node_Tree);
 
@@ -1219,12 +1217,12 @@ package body Prj.Proc is
         Configuration
       then
          Process_Project_Tree_Phase_2
-           (In_Tree                    => In_Tree,
-            Project                    => Project,
-            Success                    => Success,
-            From_Project_Node          => From_Project_Node,
-            From_Project_Node_Tree     => From_Project_Node_Tree,
-            Flags                      => Flags);
+           (In_Tree                => In_Tree,
+            Project                => Project,
+            Success                => Success,
+            From_Project_Node      => From_Project_Node,
+            From_Project_Node_Tree => From_Project_Node_Tree,
+            Flags                  => Flags);
       end if;
    end Process;
 
@@ -2273,12 +2271,12 @@ package body Prj.Proc is
    ----------------------------------
 
    procedure Process_Project_Tree_Phase_2
-     (In_Tree                    : Project_Tree_Ref;
-      Project                    : Project_Id;
-      Success                    : out Boolean;
-      From_Project_Node          : Project_Node_Id;
-      From_Project_Node_Tree     : Project_Node_Tree_Ref;
-      Flags                      : Processing_Flags)
+     (In_Tree                : Project_Tree_Ref;
+      Project                : Project_Id;
+      Success                : out Boolean;
+      From_Project_Node      : Project_Node_Id;
+      From_Project_Node_Tree : Project_Node_Tree_Ref;
+      Flags                  : Processing_Flags)
    is
       Obj_Dir    : Path_Name_Type;
       Extending  : Project_Id;
diff --git a/gcc/ada/prj-proc.ads b/gcc/ada/prj-proc.ads
index 4231b4e..40b5bf3 100644
--- a/gcc/ada/prj-proc.ads
+++ b/gcc/ada/prj-proc.ads
@@ -52,12 +52,12 @@ package Prj.Proc is
    --  project table before processing.
 
    procedure Process_Project_Tree_Phase_2
-     (In_Tree                    : Project_Tree_Ref;
-      Project                    : Project_Id;
-      Success                    : out Boolean;
-      From_Project_Node          : Project_Node_Id;
-      From_Project_Node_Tree     : Project_Node_Tree_Ref;
-      Flags                      : Processing_Flags);
+     (In_Tree                : Project_Tree_Ref;
+      Project                : Project_Id;
+      Success                : out Boolean;
+      From_Project_Node      : Project_Node_Id;
+      From_Project_Node_Tree : Project_Node_Tree_Ref;
+      Flags                  : Processing_Flags);
    --  Perform the second phase of the processing, filling the rest of the
    --  project with the information extracted from the project tree. This phase
    --  requires that the configuration file has already been parsed (in fact
diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb
index 3f5feed..45effae 100644
--- a/gcc/ada/prj.adb
+++ b/gcc/ada/prj.adb
@@ -1229,8 +1229,8 @@ package body Prj is
       Require_Sources_Other_Lang : Boolean := True;
       Allow_Duplicate_Basenames  : Boolean := True;
       Compiler_Driver_Mandatory  : Boolean := False;
-      Error_On_Unknown_Language  : Boolean := True)
-      return Processing_Flags is
+      Error_On_Unknown_Language  : Boolean := True) return Processing_Flags
+   is
    begin
       return Processing_Flags'
         (Report_Error               => Report_Error,
diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads
index 72193ca..47851fb 100644
--- a/gcc/ada/prj.ads
+++ b/gcc/ada/prj.ads
@@ -1343,10 +1343,9 @@ package Prj is
    --  project file tree. Initialize must be called before the call to Reset.
 
    type Processing_Flags is private;
-   --  Flags used while parsing and processing a project tree.
-   --  These configure various behavior in the parser, as well as indicate how
-   --  to report error messages.
-   --  This structure does not allocate memory and never needs to be freed
+   --  Flags used while parsing and processing a project tree to configure the
+   --  behavior of the parser, and indicate how to report error messages. This
+   --  structure does not allocate memory and never needs to be freed
 
    function Create_Flags
      (Report_Error               : Put_Line_Access;
@@ -1354,29 +1353,34 @@ package Prj is
       Require_Sources_Other_Lang : Boolean := True;
       Allow_Duplicate_Basenames  : Boolean := True;
       Compiler_Driver_Mandatory  : Boolean := False;
-      Error_On_Unknown_Language  : Boolean := True)
-      return Processing_Flags;
+      Error_On_Unknown_Language  : Boolean := True) return Processing_Flags;
+   --  Function used to create Processing_Flags structure
+   --
    --  If Allow_Duplicate_Basenames, then files with the same base names are
    --  authorized within a project for source-based languages (never for unit
-   --  based languages)
+   --  based languages).
+   --
    --  If Compiler_Driver_Mandatory is true, then a Compiler.Driver attribute
    --  for each language must be defined, or we will not look for its source
    --  files.
+   --
    --  When_No_Sources indicates what should be done when no sources of a
    --  language are found in a project where this language is declared.
    --  If Require_Sources_Other_Lang is true, then all languages must have at
    --  least one source file, or an error is reported via When_No_Sources. If
    --  it is false, this is only required for Ada (and only if it is a language
    --  of the project).
+   --
    --  If Report_Error is null, use the standard error reporting mechanism
    --  (Errout). Otherwise, report errors using Report_Error.
+   --
    --  If Error_On_Unknown_Language is true, an error is displayed if some of
    --  the source files listed in the project do not match any naming scheme
 
    Gprbuild_Flags : constant Processing_Flags;
    Gnatmake_Flags : constant Processing_Flags;
    --  Flags used by the various tools. They all display the error messages
-   --  through Prj.Err
+   --  through Prj.Err.
 
    package Project_Boolean_Htable is new Simple_HTable
      (Header_Num => Header_Num,