From 443614e35f5f491ae123ca92778947c47d3418f3 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 15 Apr 2009 14:14:57 +0200 Subject: [PATCH] [multiple changes] 2009-04-15 Robert Dewar * rtsfind.adb: Minor reformatting. 2009-04-15 Emmanuel Briot * prj-part.adb, prj-tree.adb, prj-tree.ads (Restore_And_Free): renames Restore, and free the saved context. 2009-04-15 Gary Dismukes * 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 --- gcc/ada/ChangeLog | 20 ++++++++++++++++ gcc/ada/prj-part.adb | 2 +- gcc/ada/prj-tree.adb | 15 ++++++++---- gcc/ada/prj-tree.ads | 4 ++-- gcc/ada/rtsfind.adb | 22 +++++++++--------- gcc/ada/sem_ch3.adb | 54 ++++++++++++++++++++++++++++++++++---------- 6 files changed, 86 insertions(+), 31 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9cf4008ac469..5d97326a457e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,23 @@ +2009-04-15 Robert Dewar + + * rtsfind.adb: Minor reformatting. + +2009-04-15 Emmanuel Briot + + * prj-part.adb, prj-tree.adb, prj-tree.ads (Restore_And_Free): renames + Restore, and free the saved context. + +2009-04-15 Gary Dismukes + + * 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 * adaint.h (__gnat_unlink): Add spec. diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index ad4c7ea7f3d8..77a98bc1f348 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 61a329fcb027..e9bc4a388536 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 75961ff08e1a..57fe531dc3da 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 d4669791cc26..9944bbf713b6 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 8f3c75ef70e0..8ee4b01af36b 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. -- 2.47.3