2014-01-21 Robert Dewar <dewar@adacore.com>

	* par-ch4.adb (P_If_Expression): Rewritten to improve error recovery.
	* par-ch5.adb (P_Condition): New version with expression prescanned.
	* par.adb (P_Condition): New version with expression prescanned.

2014-01-21  Robert Dewar  <dewar@adacore.com>

	* gnat_rm.texi: Document that Allow_Integer_Address is ignored
	if Address is not a private type.
	* sem_prag.adb (Analyze_Pragma, case Allow_Integer_Address):
	Ignore pragma if System.Address is not a private type.

2014-01-21  Arnaud Charlet  <charlet@adacore.com>

	* namet.ads (Name_Len): Initialize to 0 to avoid accessing an
	uninitialized value.



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

7 files changed, 160 insertions, 72 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a09a80e12fd..a630bc7eabb 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2014-01-21  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch4.adb (P_If_Expression): Rewritten to improve error recovery.
+	* par-ch5.adb (P_Condition): New version with expression prescanned.
+	* par.adb (P_Condition): New version with expression prescanned.
+
+2014-01-21  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Document that Allow_Integer_Address is ignored
+	if Address is not a private type.
+	* sem_prag.adb (Analyze_Pragma, case Allow_Integer_Address):
+	Ignore pragma if System.Address is not a private type.
+
+2014-01-21  Arnaud Charlet  <charlet@adacore.com>
+
+	* namet.ads (Name_Len): Initialize to 0 to avoid accessing an
+	uninitialized value.
+
 2014-01-21  Thomas Quinot  <quinot@adacore.com>
 
 	* gnat_rm.texi (Scalar_Storage_Order): Update documentation.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 9d270c92095..80aa33d6630 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -1284,6 +1284,15 @@ package AddrAsInt is
 end AddrAsInt;
 @end smallexample
 
+@noindent
+Note that pragma @code{Allow_Integer_Address} is ignored if
+@code{System.Address}
+is not a private type. In implementations of @code{GNAT} where
+System.Address is a visible integer type (notably the implementations
+for @code{OpenVMS}), this pragma serves no purpose but is ignored
+rather than rejected to allow common sets of sources to be used
+in the two situations.
+
 @node Pragma Annotate
 @unnumberedsec Pragma Annotate
 @findex Annotate
diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads
index dcce9ea91c9..4c9fc77bf78 100644
--- a/gcc/ada/namet.ads
+++ b/gcc/ada/namet.ads
@@ -130,9 +130,15 @@ package Namet is
    --  The limit here is intended to be an infinite value that ensures that we
    --  never overflow the buffer (names this long are too absurd to worry!)
 
-   Name_Len : Natural;
+   Name_Len : Natural := 0;
    --  Length of name stored in Name_Buffer. Used as an input parameter for
    --  Name_Find, and as an output value by Get_Name_String, or Write_Name.
+   --  Note: in normal usage, all users of Name_Buffer/Name_Len are expected
+   --  to initialize Name_Len appropriately. The reason we preinitialize to
+   --  zero here is that some circuitry (e.g. Osint.Write_Program_Name) does
+   --  a save/restore on Name_Len and Name_Buffer (1 .. Name_Len), and we do
+   --  not want some arbitrary junk value to result in saving an arbitrarily
+   --  long slice which would waste time and blow the stack.
 
    -----------------------------
    -- Types for Namet Package --
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index ab66f5c850a..4003d96812a 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -3076,100 +3076,139 @@ package body Ch4 is
    ---------------------
 
    function P_If_Expression return Node_Id is
-      Exprs : constant List_Id    := New_List;
-      Loc   : constant Source_Ptr := Token_Ptr;
-      Cond  : Node_Id;
-      Expr  : Node_Id;
-      State : Saved_Scan_State;
 
-   begin
-      Inside_If_Expression := Inside_If_Expression + 1;
-      Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
-      Scan; -- past IF or ELSIF
-      Cond := P_Condition;
+      function P_If_Expression_Internal
+        (Loc  : Source_Ptr;
+         Cond : Node_Id) return Node_Id;
+      --  This is the internal recursive routine that does all the work, it is
+      --  recursive since it is used to process ELSIF parts, which internally
+      --  are N_If_Expression nodes with the Is_Elsif flag set. The calling
+      --  sequence is like the outer function except that the caller passes
+      --  the conditional expression (scanned using P_Expression), and the
+      --  scan pointer points just past this expression. Loc points to the
+      --  IF or ELSIF token.
+
+      ------------------------------
+      -- P_If_Expression_Internal --
+      ------------------------------
+
+      function P_If_Expression_Internal
+        (Loc  : Source_Ptr;
+         Cond : Node_Id) return Node_Id
+      is
+         Exprs : constant List_Id    := New_List;
+         Expr  : Node_Id;
+         State : Saved_Scan_State;
+         Eptr  : Source_Ptr;
 
-      if Token = Tok_Then then
-         Scan;  --  past THEN
-         Append_To (Exprs, Cond);
-         Append_To (Exprs, P_Expression);
+      begin
+         --  All cases except where we are at right paren
 
-      else
-         Error_Msg ("ELSIF should be ELSE", Loc);
-         return Cond;
-      end if;
+         if Token /= Tok_Right_Paren then
+            TF_Then;
+            Append_To (Exprs, P_Condition (Cond));
+            Append_To (Exprs, P_Expression);
 
-      --  We now have scanned out IF expr THEN expr
+         --  Case of right paren (missing THEN phrase). Note that we know this
+         --  is the IF case, since the caller dealt with this possibility in
+         --  the ELSIF case.
 
-      --  Check for common error of semicolon before the ELSE
+         else
+            Error_Msg_BC ("missing THEN phrase");
+            Append_To (Exprs, P_Condition (Cond));
+         end if;
 
-      if Token = Tok_Semicolon then
-         Save_Scan_State (State);
-         Scan; -- past semicolon
+         --  We now have scanned out IF expr THEN expr
 
-         if Token = Tok_Else or else Token = Tok_Elsif then
-            Error_Msg_SP -- CODEFIX
-              ("|extra "";"" ignored");
+         --  Check for common error of semicolon before the ELSE
 
-         else
-            Restore_Scan_State (State);
+         if Token = Tok_Semicolon then
+            Save_Scan_State (State);
+            Scan; -- past semicolon
+
+            if Token = Tok_Else or else Token = Tok_Elsif then
+               Error_Msg_SP -- CODEFIX
+                 ("|extra "";"" ignored");
+
+            else
+               Restore_Scan_State (State);
+            end if;
          end if;
-      end if;
 
-      --  Scan out ELSIF sequence if present
+         --  Scan out ELSIF sequence if present
 
-      if Token = Tok_Elsif then
-         Expr := P_If_Expression;
+         if Token = Tok_Elsif then
+            Eptr := Token_Ptr;
+            Scan; -- past ELSIF
+            Expr := P_Expression;
 
-         if Nkind (Expr) = N_If_Expression then
-            Set_Is_Elsif (Expr);
+            --  If we are at a right paren, we assume the ELSIF should be ELSE
 
-            --  Otherwise, this is an incomplete ELSIF as reported earlier,
-            --  so treat the expression as a final ELSE for better recovery.
-         end if;
+            if Token = Tok_Right_Paren then
+               Error_Msg ("ELSIF should be ELSE", Eptr);
+               Append_To (Exprs, Expr);
 
-         Append_To (Exprs, Expr);
+            --  Otherwise we have an OK ELSIF
 
-      --  Scan out ELSE phrase if present
+            else
+               Expr := P_If_Expression_Internal (Eptr, Expr);
+               Set_Is_Elsif (Expr);
+               Append_To (Exprs, Expr);
+            end if;
 
-      elsif Token = Tok_Else then
+         --  Scan out ELSE phrase if present
 
-         --  Scan out ELSE expression
+         elsif Token = Tok_Else then
 
-         Scan; -- Past ELSE
-         Append_To (Exprs, P_Expression);
+            --  Scan out ELSE expression
 
-         --  Skip redundant ELSE parts
+            Scan; -- Past ELSE
+            Append_To (Exprs, P_Expression);
 
-         while Token = Tok_Else loop
-            Error_Msg_SC ("only one ELSE part is allowed");
-            Scan; -- past ELSE
-            Discard_Junk_Node (P_Expression);
-         end loop;
+            --  Skip redundant ELSE parts
 
-      --  Two expression case (implied True, filled in during semantics)
+            while Token = Tok_Else loop
+               Error_Msg_SC ("only one ELSE part is allowed");
+               Scan; -- past ELSE
+               Discard_Junk_Node (P_Expression);
+            end loop;
 
-      else
-         null;
-      end if;
+         --  Two expression case (implied True, filled in during semantics)
+
+         else
+            null;
+         end if;
 
-      --  If we have an END IF, diagnose as not needed
+         --  If we have an END IF, diagnose as not needed
 
-      if Token = Tok_End then
-         Error_Msg_SC ("`END IF` not allowed at end of if expression");
-         Scan; -- past END
+         if Token = Tok_End then
+            Error_Msg_SC ("`END IF` not allowed at end of if expression");
+            Scan; -- past END
 
-         if Token = Tok_If then
-            Scan; -- past IF;
+            if Token = Tok_If then
+               Scan; -- past IF;
+            end if;
          end if;
-      end if;
 
-      Inside_If_Expression := Inside_If_Expression - 1;
+         --  Return the If_Expression node
+
+         return Make_If_Expression (Loc, Expressions => Exprs);
+      end P_If_Expression_Internal;
+
+   --  Local variables
+
+      Loc     : constant Source_Ptr := Token_Ptr;
+      If_Expr : Node_Id;
 
-      --  Return the If_Expression node
+   --  Start of processing for P_If_Expression
 
-      return
-        Make_If_Expression (Loc,
-          Expressions => Exprs);
+   begin
+      Error_Msg_Ada_2012_Feature ("|if expression", Token_Ptr);
+      Scan; -- past IF
+      Inside_If_Expression := Inside_If_Expression + 1;
+      If_Expr := P_If_Expression_Internal (Loc, P_Expression);
+      Inside_If_Expression := Inside_If_Expression - 1;
+      return If_Expr;
    end P_If_Expression;
 
    -----------------------
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 94c5bd4d073..e20cf11a685 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1256,11 +1256,12 @@ package body Ch5 is
    --  CONDITION ::= boolean_EXPRESSION
 
    function P_Condition return Node_Id is
-      Cond : Node_Id;
-
    begin
-      Cond := P_Expression_No_Right_Paren;
+      return P_Condition (P_Expression_No_Right_Paren);
+   end P_Condition;
 
+   function P_Condition (Cond : Node_Id) return Node_Id is
+   begin
       --  It is never possible for := to follow a condition, so if we get
       --  a := we assume it is a mistyped equality. Note that we do not try
       --  to reconstruct the tree correctly in this case, but we do at least
@@ -1278,7 +1279,7 @@ package body Ch5 is
 
       --  Otherwise check for redundant parentheses
 
-      --  If the  condition is a conditional or a quantified expression, it is
+      --  If the condition is a conditional or a quantified expression, it is
       --  parenthesized in the context of a condition, because of a separate
       --  syntax rule.
 
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index ac21375ef46..6788692864e 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -737,7 +737,13 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
 
    package Ch5 is
       function P_Condition return Node_Id;
-      --  Scan out and return a condition
+      --  Scan out and return a condition. Note that an error is given if
+      --  the condition is followed by a right parenthesis.
+
+      function P_Condition (Cond : Node_Id) return Node_Id;
+      --  Similar to the above, but the caller has already scanned out the
+      --  conditional expression and passes it as an argument. This form of
+      --  the call does not check for a following right parenthesis.
 
       function P_Loop_Parameter_Specification return Node_Id;
       --  Used in loop constructs and quantified expressions.
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 043dc4e0c8b..347feb2206f 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -10206,8 +10206,17 @@ package body Sem_Prag is
 
          when Pragma_Allow_Integer_Address =>
             GNAT_Pragma;
+            Check_Valid_Configuration_Pragma;
             Check_Arg_Count (0);
-            Opt.Allow_Integer_Address := True;
+
+            --  If Address is a private type, then set the flag to allow
+            --  integer address values. If Address is not private (e.g. on
+            --  VMS, where it is an integer type), then this pragma has no
+            --  purpose, so it is simply ignored.
+
+            if Is_Private_Type (RTE (RE_Address)) then
+               Opt.Allow_Integer_Address := True;
+            end if;
 
          --------------
          -- Annotate --