[multiple changes]

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* scng.adb (Skip_Other_Format_Characters): New procedure
	(Start_Of_Wide_Character): New procedure
	(Scan): Use Start_Of_Wide_Character where appropriate
	(Scan): Improve error message for other_format chars in identifier
	(Scan): Allow other_format chars between tokens

2010-10-07  Javier Miranda  <miranda@adacore.com>

	* exp_util.adb (Safe_Prefixed_Reference): When removing side effects,
	Add missing support for explicit dereferences.

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* par-ch10.adb, par-ch3.adb, par.adb: Minor reformatting.

From-SVN: r165097

6 files changed, 161 insertions, 78 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a46fb54..2901a1c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,22 @@
 2010-10-07  Robert Dewar  <dewar@adacore.com>
 
+	* scng.adb (Skip_Other_Format_Characters): New procedure
+	(Start_Of_Wide_Character): New procedure
+	(Scan): Use Start_Of_Wide_Character where appropriate
+	(Scan): Improve error message for other_format chars in identifier
+	(Scan): Allow other_format chars between tokens
+
+2010-10-07  Javier Miranda  <miranda@adacore.com>
+
+	* exp_util.adb (Safe_Prefixed_Reference): When removing side effects,
+	Add missing support for explicit dereferences.
+
+2010-10-07  Robert Dewar  <dewar@adacore.com>
+
+	* par-ch10.adb, par-ch3.adb, par.adb: Minor reformatting.
+
+2010-10-07  Robert Dewar  <dewar@adacore.com>
+
 	* exp_disp.adb, exp_dist.adb, exp_util.ads, exp_util.adb,
 	exp_ch11.adb: Rename Full_Qualified_Name to Fully_Qualified_Name_String
 	* sem_util.adb, sem_util.ads (Full_Qualified_Name): Moved to
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index ae8a8e6..112fe04 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -4538,6 +4538,25 @@ package body Exp_Util is
                  or else Ekind (Entity (Prefix (N))) = E_In_Parameter;
             end if;
 
+         --  If the prefix is an explicit dereference that is not access-to-
+         --  constant then this construct is a variable reference, which means
+         --  it is to be considered to have side effects if Variable_Ref is
+         --  True.
+
+         --  Exception is an access to an entity that is a constant or an
+         --  in-parameter.
+
+         elsif Nkind (Prefix (N)) = N_Explicit_Dereference
+           and then not Is_Access_Constant (Etype (Prefix (Prefix (N))))
+           and then Variable_Ref
+         then
+            declare
+               DDT : constant Entity_Id :=
+                       Designated_Type (Etype (Prefix (Prefix (N))));
+            begin
+               return Ekind_In (DDT, E_Constant, E_In_Parameter);
+            end;
+
          --  The following test is the simplest way of solving a complex
          --  problem uncovered by BB08-010: Side effect on loop bound that
          --  is a subcomponent of a global variable:
diff --git a/gcc/ada/par-ch10.adb b/gcc/ada/par-ch10.adb
index e321aff..c7dfee8 100644
--- a/gcc/ada/par-ch10.adb
+++ b/gcc/ada/par-ch10.adb
@@ -634,7 +634,6 @@ package body Ch10 is
          --  Check we did not with any child units
 
          Item := First (Context_Items (Comp_Unit_Node));
-
          while Present (Item) loop
             if Nkind (Item) = N_With_Clause
               and then Nkind (Name (Item)) /= N_Identifier
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index ae1ba66..18188ba 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -4335,23 +4335,23 @@ package body Ch3 is
                Done := True;
             end if;
 
-            --  Normally an END terminates the scan for basic declarative
-            --  items. The one exception is END RECORD, which is probably
-            --  left over from some other junk.
+         --  Normally an END terminates the scan for basic declarative items.
+         --  The one exception is END RECORD, which is probably left over from
+         --  some other junk.
 
-            when Tok_End =>
-               Save_Scan_State (Scan_State); -- at END
-               Scan; -- past END
+         when Tok_End =>
+            Save_Scan_State (Scan_State); -- at END
+            Scan; -- past END
 
-               if Token = Tok_Record then
-                  Error_Msg_SP ("no RECORD for this `end record`!");
-                  Scan; -- past RECORD
-                  TF_Semicolon;
+            if Token = Tok_Record then
+               Error_Msg_SP ("no RECORD for this `end record`!");
+               Scan; -- past RECORD
+               TF_Semicolon;
 
-               else
-                  Restore_Scan_State (Scan_State); -- to END
-                  Done := True;
-               end if;
+            else
+               Restore_Scan_State (Scan_State); -- to END
+               Done := True;
+            end if;
 
          --  The following tokens which can only be the start of a statement
          --  are considered to end a declarative part (i.e. we have a missing
diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb
index 28c2ca7..8a0c901 100644
--- a/gcc/ada/par.adb
+++ b/gcc/ada/par.adb
@@ -361,17 +361,17 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
    function F return Boolean renames False;
 
    Pf_Decl_Gins_Pbod_Rnam_Stub : constant Pf_Rec :=
-                                             Pf_Rec'(F, T, T, T, T, T, F, F);
+                                   Pf_Rec'(F, T, T, T, T, T, F, F);
    Pf_Decl                     : constant Pf_Rec :=
-                                             Pf_Rec'(F, T, F, F, F, F, F, F);
+                                   Pf_Rec'(F, T, F, F, F, F, F, F);
    Pf_Decl_Gins_Pbod_Rnam      : constant Pf_Rec :=
-                                             Pf_Rec'(F, T, T, T, T, F, F, F);
+                                   Pf_Rec'(F, T, T, T, T, F, F, F);
    Pf_Decl_Pbod                : constant Pf_Rec :=
-                                             Pf_Rec'(F, T, F, T, F, F, F, F);
+                                   Pf_Rec'(F, T, F, T, F, F, F, F);
    Pf_Pbod                     : constant Pf_Rec :=
-                                             Pf_Rec'(F, F, F, T, F, F, F, F);
+                                   Pf_Rec'(F, F, F, T, F, F, F, F);
    Pf_Spcn                     : constant Pf_Rec :=
-                                             Pf_Rec'(T, F, F, F, F, F, F, F);
+                                   Pf_Rec'(T, F, F, F, F, F, F, F);
    --  The above are the only allowed values of Pf_Rec arguments
 
    type SS_Rec is record
diff --git a/gcc/ada/scng.adb b/gcc/ada/scng.adb
index bc34eab..d838445 100644
--- a/gcc/ada/scng.adb
+++ b/gcc/ada/scng.adb
@@ -241,6 +241,14 @@ package body Scng is
       --  past the closing quote of the string literal, Token and Token_Node
       --  are set appropriately, and the checksum is updated.
 
+      procedure Skip_Other_Format_Characters;
+      --  Skips past any "other format" category characters at the current
+      --  cursor location (does not skip past spaces or any other characters).
+
+      function Start_Of_Wide_Character return Boolean;
+      --  Returns True if the scan pointer is pointing to the start of a wide
+      --  character sequence, does not modify the scan pointer in any case.
+
       -----------------------
       -- Check_End_Of_Line --
       -----------------------
@@ -1039,15 +1047,7 @@ package body Scng is
                   Code := Get_Char_Code (C);
                   Scan_Ptr := Scan_Ptr + 1;
 
-               elsif (C = ESC
-                        and then Wide_Character_Encoding_Method
-                                   in WC_ESC_Encoding_Method)
-                 or else (C in Upper_Half_Character
-                            and then Upper_Half_Encoding)
-                 or else (C = '['
-                            and then Source (Scan_Ptr + 1) = '"'
-                            and then Identifier_Char (Source (Scan_Ptr + 2)))
-               then
+               elsif Start_Of_Wide_Character then
                   Wptr := Scan_Ptr;
                   Scan_Wide (Source, Scan_Ptr, Code, Err);
 
@@ -1109,6 +1109,62 @@ package body Scng is
          return;
       end Slit;
 
+      ----------------------------------
+      -- Skip_Other_Format_Characters --
+      ----------------------------------
+
+      procedure Skip_Other_Format_Characters is
+         P    : Source_Ptr;
+         Code : Char_Code;
+         Err  : Boolean;
+
+      begin
+         while Start_Of_Wide_Character loop
+            P := Scan_Ptr;
+            Scan_Wide (Source, Scan_Ptr, Code, Err);
+
+            if not Is_UTF_32_Other (UTF_32 (Code)) then
+               Scan_Ptr := P;
+               return;
+            end if;
+         end loop;
+      end Skip_Other_Format_Characters;
+
+      -----------------------------
+      -- Start_Of_Wide_Character --
+      -----------------------------
+
+      function Start_Of_Wide_Character return Boolean is
+         C : constant Character := Source (Scan_Ptr);
+
+      begin
+         --  ESC encoding method with ESC present
+
+         if C = ESC
+           and then Wide_Character_Encoding_Method in WC_ESC_Encoding_Method
+         then
+            return True;
+
+         --  Upper half character with upper half encoding
+
+         elsif C in Upper_Half_Character and then Upper_Half_Encoding then
+            return True;
+
+         --  Brackets encoding
+
+         elsif C = '['
+           and then Source (Scan_Ptr + 1) = '"'
+           and then Identifier_Char (Source (Scan_Ptr + 2))
+         then
+            return True;
+
+         --  Not the start of a wide character
+
+         else
+            return False;
+         end if;
+      end Start_Of_Wide_Character;
+
    --  Start of processing for Scan
 
    begin
@@ -1513,12 +1569,7 @@ package body Scng is
                   --  If we have a wide character, we have to scan it out,
                   --  because it might be a legitimate line terminator
 
-                  elsif (Source (Scan_Ptr) = ESC
-                           and then Identifier_Char (ESC))
-                    or else
-                         (Source (Scan_Ptr) in Upper_Half_Character
-                            and then Upper_Half_Encoding)
-                  then
+                  elsif Start_Of_Wide_Character then
                      declare
                         Wptr : constant Source_Ptr := Scan_Ptr;
                         Code : Char_Code;
@@ -1626,18 +1677,7 @@ package body Scng is
             else
                --  Case of wide character literal
 
-               if (Source (Scan_Ptr) = ESC
-                     and then
-                    Wide_Character_Encoding_Method in WC_ESC_Encoding_Method)
-                 or else
-                   (Source (Scan_Ptr) in Upper_Half_Character
-                     and then
-                    Upper_Half_Encoding)
-                 or else
-                   (Source (Scan_Ptr) = '['
-                     and then
-                    Source (Scan_Ptr + 1) = '"')
-               then
+               if Start_Of_Wide_Character then
                   Wptr := Scan_Ptr;
                   Scan_Wide (Source, Scan_Ptr, Code, Err);
                   Accumulate_Checksum (Code);
@@ -1872,6 +1912,10 @@ package body Scng is
 
             Nlit;
 
+            --  Check for proper delimiter, ignoring other format characters
+
+            Skip_Other_Format_Characters;
+
             if Identifier_Char (Source (Scan_Ptr)) then
                Error_Msg_S
                  ("delimiter required between literal and identifier");
@@ -2039,6 +2083,12 @@ package body Scng is
             elsif Is_UTF_32_Space (Cat) then
                goto Scan_Next_Character;
 
+            --  If other format character, ignore and keep scanning (again we
+            --  do not include in the checksum) (this is for AI-0079).
+
+            elsif Is_UTF_32_Other (Cat) then
+               goto Scan_Next_Character;
+
             --  If OK wide line terminator, terminate current line
 
             elsif Is_UTF_32_Line_Terminator (UTF_32 (Code)) then
@@ -2063,16 +2113,6 @@ package body Scng is
                Underline_Found := False;
                goto Scan_Identifier;
 
-            --  Other format character is an error (at start of identifier)
-
-            elsif Is_UTF_32_Other (Cat) then
-               Error_Msg
-                 ("identifier cannot start with other format character", Wptr);
-               Scan_Ptr := Wptr;
-               Name_Len := 0;
-               Underline_Found := False;
-               goto Scan_Identifier;
-
             --  Extended digit character is an error. Could be bad start of
             --  identifier or bad literal. Not worth doing too much to try to
             --  distinguish these cases, but we will do a little bit.
@@ -2255,6 +2295,33 @@ package body Scng is
                   --  Here if not a normal identifier character
 
                   else
+                     Cat := Get_Category (UTF_32 (Code));
+
+                     --  Wide character in Unicode category "Other, Format"
+                     --  is not accepted in an identifier. This is because it
+                     --  it is considered a security risk (AI-0091).
+
+                     --  However, it is OK for such a character to appear at
+                     --  the end of an identifier.
+
+                     if Is_UTF_32_Other (Cat) then
+                        if not Identifier_Char (Source (Scan_Ptr)) then
+                           goto Scan_Identifier_Complete;
+                        else
+                           Error_Msg
+                             ("identifier cannot contain other_format "
+                              & "character", Wptr);
+                           goto Scan_Identifier;
+                        end if;
+
+                     --  Wide character in category Separator,Space terminates
+
+                     elsif Is_UTF_32_Space (Cat) then
+                        goto Scan_Identifier_Complete;
+                     end if;
+
+                     --  Here if wide character is part of the identifier
+
                      --  Make sure we are allowing wide characters in
                      --  identifiers. Note that we allow wide character
                      --  notation for an OK identifier character. This in
@@ -2267,11 +2334,9 @@ package body Scng is
                        and then Ada_Version < Ada_05
                      then
                         Error_Msg
-                       ("wide character not allowed in identifier", Wptr);
+                          ("wide character not allowed in identifier", Wptr);
                      end if;
 
-                     Cat := Get_Category (UTF_32 (Code));
-
                      --  If OK letter, store it folding to upper case. Note
                      --  that we include the folded letter in the checksum.
 
@@ -2311,23 +2376,6 @@ package body Scng is
                            Underline_Found := True;
                         end if;
 
-                     --  Wide character in Unicode category "Other, Format"
-                     --  is accepted in an identifier, but is ignored and not
-                     --  stored. It seems reasonable to exclude it from the
-                     --  checksum.
-
-                     --  Note that it is correct (see AI-395) to simply strip
-                     --  other format characters, before testing for double
-                     --  underlines, or for reserved words).
-
-                     elsif Is_UTF_32_Other (Cat) then
-                        null;
-
-                     --  Wide character in category Separator,Space terminates
-
-                     elsif Is_UTF_32_Space (Cat) then
-                        goto Scan_Identifier_Complete;
-
                      --  Any other wide character is not acceptable
 
                      else