2013-04-22 Pascal Obry <obry@adacore.com>

	* gnat_ugn.texi, prj-nmsc.adb, projects.texi: Add check for
	Library_Standalone and Library_Kind.

2013-04-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch6.adb (Expand_Actuals): If the call is to an
	inherited operation and the actual is a by-reference type with
	predicates, add predicate call to post-call actions.
	* sem_util.adb (Is_Inherited_Operation_For_Type): Fix coding
	error: a type declaration has a defining identifier, not an Etype.
	* sem_res.adb: Restore code removed because of above error.

2013-04-22  Doug Rupp  <rupp@adacore.com>

	* init.c (__gnat_handle_vms_condition): Also match C$_SIGINT.



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

8 files changed, 94 insertions, 23 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1b2d967de29..18dd3b1ecae 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,21 @@
+2013-04-22  Pascal Obry  <obry@adacore.com>
+
+	* gnat_ugn.texi, prj-nmsc.adb, projects.texi: Add check for
+	Library_Standalone and Library_Kind.
+
+2013-04-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch6.adb (Expand_Actuals): If the call is to an
+	inherited operation and the actual is a by-reference type with
+	predicates, add predicate call to post-call actions.
+	* sem_util.adb (Is_Inherited_Operation_For_Type): Fix coding
+	error: a type declaration has a defining identifier, not an Etype.
+	* sem_res.adb: Restore code removed because of above error.
+
+2013-04-22  Doug Rupp  <rupp@adacore.com>
+
+	* init.c (__gnat_handle_vms_condition): Also match C$_SIGINT.
+
 2013-04-22  Yannick Moy  <moy@adacore.com>
 
 	* gnat_rm.texi, exp_util.adb, sem_prag.adb, sem_prag.ads, par-ch2.adb,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 5c5c809e880..35060e714b2 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -942,6 +942,7 @@ package body Exp_Ch6 is
       Formal    : Entity_Id;
       N_Node    : Node_Id;
       Post_Call : List_Id;
+      E_Actual  : Entity_Id;
       E_Formal  : Entity_Id;
 
       procedure Add_Call_By_Copy_Code;
@@ -1508,6 +1509,7 @@ package body Exp_Ch6 is
       Actual := First_Actual (N);
       while Present (Formal) loop
          E_Formal := Etype (Formal);
+         E_Actual := Etype (Actual);
 
          if Is_Scalar_Type (E_Formal)
            or else Nkind (Actual) = N_Slice
@@ -1645,7 +1647,7 @@ package body Exp_Ch6 is
             --  conversion" errors.
 
             elsif Is_Access_Type (E_Formal)
-              and then not Same_Type (E_Formal, Etype (Actual))
+              and then not Same_Type (E_Formal, E_Actual)
               and then not Is_Tagged_Type (Designated_Type (E_Formal))
             then
                Add_Call_By_Copy_Code;
@@ -1661,7 +1663,7 @@ package body Exp_Ch6 is
 
             elsif Is_Entity_Name (Actual)
               and then Is_Volatile (Entity (Actual))
-              and then not Is_By_Reference_Type (Etype (Actual))
+              and then not Is_By_Reference_Type (E_Actual)
               and then not Is_Scalar_Type (Etype (Entity (Actual)))
               and then not Is_Volatile (E_Formal)
             then
@@ -1682,10 +1684,10 @@ package body Exp_Ch6 is
 
             elsif Is_Scalar_Type (E_Formal)
               and then
-                (not In_Subrange_Of (E_Formal, Etype (Actual))
+                (not In_Subrange_Of (E_Formal, E_Actual)
                   or else
                     (Ekind (Formal) = E_In_Out_Parameter
-                      and then not In_Subrange_Of (Etype (Actual), E_Formal)))
+                      and then not In_Subrange_Of (E_Actual, E_Formal)))
             then
                --  Perhaps the setting back to False should be done within
                --  Add_Call_By_Copy_Code, since it could get set on other
@@ -1698,6 +1700,28 @@ package body Exp_Ch6 is
                Add_Call_By_Copy_Code;
             end if;
 
+            --  RM 3.2.4 (23/3) : A predicate is checked on in-out and out
+            --  by-reference parameters on exit from the call. If the actual
+            --  is a derived type and the operation is inherited, the body
+            --  of the operation will not contain a call to the predicate
+            --  function, so it must be done explicitly after the call. Ditto
+            --  if the actual is an entity of a predicated subtype.
+
+            if Is_By_Reference_Type (E_Formal)
+              and then Has_Predicates (E_Actual)
+            then
+               if Is_Derived_Type (E_Actual)
+                 and then Is_Inherited_Operation_For_Type (Subp, E_Actual)
+               then
+                  Append_To
+                   (Post_Call, Make_Predicate_Check (E_Actual, Actual));
+
+               elsif Is_Entity_Name (Actual) then
+                  Append_To
+                   (Post_Call, Make_Predicate_Check (E_Actual, Actual));
+               end if;
+            end if;
+
          --  Processing for IN parameters
 
          else
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 17f0f843748..2a8610b28c8 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -17083,6 +17083,7 @@ build an encapsulated library the attribute
 @group
    for Library_Dir use "lib_dir";
    for Library_Name use "dummy";
+   for Library_Kind use "dynamic";
    for Library_Interface use ("int1", "int1.child");
    for Library_Standalone use "encapsulated";
 @end group
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index 8408225dd7b..030cb5c3f82 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -833,6 +833,7 @@ void (*__gnat_ctrl_c_handler) (void) = 0;
 
 /* These codes are in standard message libraries.  */
 extern int C$_SIGKILL;
+extern int C$_SIGINT;
 extern int SS$_DEBUG;
 extern int LIB$_KEYNOTFOU;
 extern int LIB$_ACTIMAGE;
@@ -1221,14 +1222,18 @@ __gnat_handle_vms_condition (int *sigargs, void *mechargs)
 					          system_cond_except_table,
 					          0};
       unsigned int ctrlc = SS$_CONTROLC;
+      unsigned int *sigint = &C$_SIGINT;
       int ctrlc_match = LIB$MATCH_COND (&sigargs [1], &ctrlc);
+      int sigint_match = LIB$MATCH_COND (&sigargs [1], &sigint);
 
       extern int SYS$DCLAST (void (*astadr)(), unsigned long long astprm,
 	                     unsigned int acmode);
 
       /* If SS$_CONTROLC has been imported as an exception, it will take
-	 priority over a a Ctrl/C handler.  See above.  */
-      if (ctrlc_match && __gnat_ctrl_c_handler)
+	 priority over a a Ctrl/C handler.  See above.  SIGINT has a
+	 different condition value due to it's DECCCRTL roots and it's
+	 the condition that gets raised for a "kill -INT".  */
+      if ((ctrlc_match || sigint_match) && __gnat_ctrl_c_handler)
 	{
 	  SYS$DCLAST (__gnat_ctrl_c_handler, 0, 0);
 	  return SS$_CONTINUE;
diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb
index 1ead9365e5b..f1538de9922 100644
--- a/gcc/ada/prj-nmsc.adb
+++ b/gcc/ada/prj-nmsc.adb
@@ -3659,6 +3659,21 @@ package body Prj.Nmsc is
          end loop;
       end if;
 
+      if not Lib_Standalone.Default
+        and then Project.Library_Kind = Static
+      then
+         --  An standalone library must be a shared library
+
+         Error_Msg_Name_1 := Project.Name;
+
+         Error_Msg
+           (Data.Flags,
+            Continuation.all &
+              "standalone library project %% must be a shared library",
+            Project.Location, Project);
+         Continuation := Continuation_String'Access;
+      end if;
+
       if Project.Library and not Data.In_Aggregate_Lib then
 
          --  Record the library name
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index ca477369b13..2c334686b54 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -1890,12 +1890,15 @@ language and takes a list of sources as parameter.
   library can furthermore only depends on static libraries (including
   the GNAT runtime). This attribute can be set to @code{no} to make it clear
   that the library should not be standalone in which case the
-  @code{Library_Interface} should not defined.
+  @code{Library_Interface} should not defined. Note that this attribute
+  only applies to shared libraries, so @code{Library_Kind} must be set
+  to @code{dynamic}.
 
 @smallexample @c projectfile
 @group
      for Library_Dir use "lib";
      for Library_Name use "loggin";
+     for Library_Kind use "dynamic";
      for Library_Interface use ("lib1", "lib2");  --  unit names
      for Library_Standalone use "encapsulated";
 @end group
@@ -3772,8 +3775,15 @@ The list of languages of the sources of the project.
 
 @item @b{Roots}: list, indexed, file name index
 
-The index is the file name of an executable source. Indicates the list of
-units that need to be bound and linked with their closures with the executable.
+The index is the file name of an executable source. Indicates the list of units
+from the main project that need to be bound and linked with their closures
+with the executable. The index is either a file name, a language name or "*".
+The roots for an executable source are those in @b{Roots} with an index that
+is the executable source file name, if declared. Otherwise, they are those in
+@b{Roots} with an index that is the language name of the executable source,
+if present. Otherwise, they are those in @b{Roots ("*")}, if declared. If none
+of these three possibilities are declared, then there are no roots for the
+executable source.
 
 @item @b{Externally_Built}: single
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f78f2ae2d48..63bbef6645b 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5896,19 +5896,14 @@ package body Sem_Res is
       --  In formal mode, the primitive operations of a tagged type or type
       --  extension do not include functions that return the tagged type.
 
-      --  Commented out as the call to Is_Inherited_Operation_For_Type may
-      --  cause an error because the type entity of the parent node of
-      --  Entity (Name (N) may not be set. ???
-      --  So why not just add a guard ???
-
---      if Nkind (N) = N_Function_Call
---        and then Is_Tagged_Type (Etype (N))
---        and then Is_Entity_Name (Name (N))
---        and then Is_Inherited_Operation_For_Type
---                   (Entity (Name (N)), Etype (N))
---      then
---         Check_SPARK_Restriction ("function not inherited", N);
---      end if;
+      if Nkind (N) = N_Function_Call
+        and then Is_Tagged_Type (Etype (N))
+        and then Is_Entity_Name (Name (N))
+        and then Is_Inherited_Operation_For_Type
+                   (Entity (Name (N)), Etype (N))
+      then
+         Check_SPARK_Restriction ("function not inherited", N);
+      end if;
 
       --  Implement rule in 12.5.1 (23.3/2): In an instance, if the actual is
       --  class-wide and the call dispatches on result in a context that does
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 00db63d6f9c..fb4512914da 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8462,8 +8462,11 @@ package body Sem_Util is
       Typ : Entity_Id) return Boolean
    is
    begin
+      --  Check that the operation has been created by the declaration for
+      --  the type.
+
       return Is_Inherited_Operation (E)
-        and then Etype (Parent (E)) = Typ;
+        and then Defining_Identifier (Parent (E)) = Typ;
    end Is_Inherited_Operation_For_Type;
 
    -----------------