[multiple changes]

2009-04-15  Robert Dewar  <dewar@adacore.com>

	* rtsfind.adb: Minor reformatting.

2009-04-15  Emmanuel Briot  <briot@adacore.com>

	* prj-part.adb, prj-tree.adb, prj-tree.ads (Restore_And_Free): renames
	Restore, and free the saved context.

2009-04-15  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch3.adb (Analyze_Private_Extension_Declaration): Move error check
	for illegal private extension from a synchronized interface parent in
	front of check for illegal limited extension so that limited extension
	from a synchronized interface will be rejected.
	(Check_Ifaces): Check that a private extension that has a synchronized
	interface as a progenitor must be explicitly declared synchronized.
	Also check that a record extension cannot derive from a synchronized
	interface.

From-SVN: r146103

6 files changed, 86 insertions, 31 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9cf4008..5d97326 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2009-04-15  Robert Dewar  <dewar@adacore.com>
+
+	* rtsfind.adb: Minor reformatting.
+
+2009-04-15  Emmanuel Briot  <briot@adacore.com>
+
+	* prj-part.adb, prj-tree.adb, prj-tree.ads (Restore_And_Free): renames
+	Restore, and free the saved context.
+
+2009-04-15  Gary Dismukes  <dismukes@adacore.com>
+
+	* sem_ch3.adb (Analyze_Private_Extension_Declaration): Move error check
+	for illegal private extension from a synchronized interface parent in
+	front of check for illegal limited extension so that limited extension
+	from a synchronized interface will be rejected.
+	(Check_Ifaces): Check that a private extension that has a synchronized
+	interface as a progenitor must be explicitly declared synchronized.
+	Also check that a record extension cannot derive from a synchronized
+	interface.
+
 2009-04-15  Pascal Obry  <obry@adacore.com>
 
 	* adaint.h (__gnat_unlink): Add spec.
diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb
index ad4c7ea..77a98bc 100644
--- a/gcc/ada/prj-part.adb
+++ b/gcc/ada/prj-part.adb
@@ -1738,7 +1738,7 @@ package body Prj.Part is
 
       --  And restore the comment state that was saved
 
-      Tree.Restore (Project_Comment_State);
+      Tree.Restore_And_Free (Project_Comment_State);
    end Parse_Single_Project;
 
    -----------------------
diff --git a/gcc/ada/prj-tree.adb b/gcc/ada/prj-tree.adb
index 61a329f..e9bc4a3 100644
--- a/gcc/ada/prj-tree.adb
+++ b/gcc/ada/prj-tree.adb
@@ -1502,11 +1502,14 @@ package body Prj.Tree is
       Comments.Set_Last (0);
    end Reset_State;
 
-   -------------
-   -- Restore --
-   -------------
+   ----------------------
+   -- Restore_And_Free --
+   ----------------------
+
+   procedure Restore_And_Free (S : in out Comment_State) is
+      procedure Unchecked_Free is new
+        Ada.Unchecked_Deallocation (Comment_Array, Comments_Ptr);
 
-   procedure Restore (S : Comment_State) is
    begin
       End_Of_Line_Node   := S.End_Of_Line_Node;
       Previous_Line_Node := S.Previous_Line_Node;
@@ -1520,7 +1523,9 @@ package body Prj.Tree is
          Comments.Increment_Last;
          Comments.Table (Comments.Last) := S.Comments (J);
       end loop;
-   end Restore;
+
+      Unchecked_Free (S.Comments);
+   end Restore_And_Free;
 
    ----------
    -- Save --
diff --git a/gcc/ada/prj-tree.ads b/gcc/ada/prj-tree.ads
index 75961ff..57fe531 100644
--- a/gcc/ada/prj-tree.ads
+++ b/gcc/ada/prj-tree.ads
@@ -131,9 +131,9 @@ package Prj.Tree is
    --  Save in variable S the comment state. Called before scanning a new
    --  project file.
 
-   procedure Restore (S : Comment_State);
+   procedure Restore_And_Free (S : in out Comment_State);
    --  Restore the comment state to a previously saved value. Called after
-   --  scanning a project file.
+   --  scanning a project file. Frees the memory occupied by S
 
    procedure Reset_State;
    --  Set the comment state to its initial value. Called before scanning a
diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index d466979..9944bbf 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -797,7 +797,7 @@ package body Rtsfind is
 
    procedure Maybe_Add_With (E : RE_Id; U : in out RT_Unit_Table_Record) is
       Is_Main : constant Boolean :=
-        In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
+                  In_Extended_Main_Code_Unit (Cunit_Entity (Current_Sem_Unit));
 
    begin
       --  We do not need to generate a with_clause for a call issued from
@@ -831,18 +831,18 @@ package body Rtsfind is
       --  Here if we've decided to add the with_clause
 
       declare
-         Lib_Unit : constant Node_Id := Unit (Cunit (U.Unum));
-         Withn    : constant Node_Id :=
-           Make_With_Clause (Standard_Location,
-             Name =>
-               Make_Unit_Name
-                 (E, Defining_Unit_Name (Specification (Lib_Unit))));
+         LibUnit : constant Node_Id := Unit (Cunit (U.Unum));
+         Withn   : constant Node_Id :=
+                     Make_With_Clause (Standard_Location,
+                       Name =>
+                         Make_Unit_Name
+                           (E, Defining_Unit_Name (Specification (LibUnit))));
 
       begin
-         Set_Library_Unit          (Withn, Cunit (U.Unum));
-         Set_Corresponding_Spec    (Withn, U.Entity);
-         Set_First_Name            (Withn, True);
-         Set_Implicit_With         (Withn, True);
+         Set_Library_Unit       (Withn, Cunit (U.Unum));
+         Set_Corresponding_Spec (Withn, U.Entity);
+         Set_First_Name         (Withn, True);
+         Set_Implicit_With      (Withn, True);
 
          Mark_Rewrite_Insertion (Withn);
          Append (Withn, Context_Items (Cunit (Current_Sem_Unit)));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8f3c75e..8ee4b01 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3326,6 +3326,21 @@ package body Sem_Ch3 is
             end if;
          end if;
 
+      --  A consequence of 3.9.4 (6/2) and 7.3 (7.2/2) is that a private
+      --  extension with a synchronized parent must be explicitly declared
+      --  synchronized, because the full view will be a synchronized type.
+      --  This must be checked before the check for limited types below,
+      --  to ensure that types declared limited are not allowed extend
+      --  synchronized interfaces.
+
+      elsif Is_Interface (Parent_Type)
+        and then Is_Synchronized_Interface (Parent_Type)
+        and then not Synchronized_Present (N)
+      then
+         Error_Msg_NE
+           ("private extension of& must be explicitly synchronized",
+             N, Parent_Type);
+
       elsif Limited_Present (N) then
          Set_Is_Limited_Record (T);
 
@@ -3337,18 +3352,6 @@ package body Sem_Ch3 is
             Error_Msg_NE ("parent type& of limited extension must be limited",
               N, Parent_Type);
          end if;
-
-      --  A consequence of 3.9.4 (6/2) and 7.3 (2.2/2) is that a private
-      --  extension with a synchronized parent must be explicitly declared
-      --  synchronized, because the full view will be a synchronized type.
-
-      elsif Is_Interface (Parent_Type)
-        and then Is_Synchronized_Interface (Parent_Type)
-        and then not Synchronized_Present (N)
-      then
-         Error_Msg_NE
-           ("private extension of& must be explicitly synchronized",
-             N, Parent_Type);
       end if;
    end Analyze_Private_Extension_Declaration;
 
@@ -8712,6 +8715,33 @@ package body Sem_Ch3 is
             Is_Protected := True;
          end if;
 
+         if Is_Synchronized_Interface (Iface_Id) then
+
+            --  A consequence of 3.9.4 (6/2) and 7.3 (7.2/2) is that a private
+            --  extension derived from a synchronized interface must explicitly
+            --  be declared synchronized, because the full view will be a
+            --  synchronized type.
+
+            if Nkind (N) = N_Private_Extension_Declaration then
+               if not Synchronized_Present (N) then
+                  Error_Msg_NE
+                    ("private extension of& must be explicitly synchronized",
+                      N, Iface_Id);
+               end if;
+
+            --  However, by 3.9.4(16/2), a full type that is a record extension
+            --  is never allowed to derive from a synchronized interface (note
+            --  that interfaces must be excluded from this check, because those
+            --  are represented by derived type definitions in some cases).
+
+            elsif Nkind (Type_Definition (N)) = N_Derived_Type_Definition
+              and then not Interface_Present (Type_Definition (N))
+            then
+               Error_Msg_N ("record extension cannot derive from synchronized"
+                             & " interface", Error_Node);
+            end if;
+         end if;
+
          --  Check that the characteristics of the progenitor are compatible
          --  with the explicit qualifier in the declaration.
          --  The check only applies to qualifiers that come from source.