]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
2009-04-24 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 24 Apr 2009 10:37:20 +0000 (10:37 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 24 Apr 2009 10:37:20 +0000 (10:37 +0000)
* sem_res.adb (Resolve_Actuals): Do not create blocks around code
statements, even though the actual of the call is a concatenation,
because the argument is static, and we want to preserve warning
messages  about sequences of code statements that are not marked
volatile.

* sem_warn.adb: remove obsolete comment about warning being obsolete

* s-tasren.adb (Task_Do_Or_Queue): If a timed entry call is being
requeued and the delay has expired while within the accept statement
that executes the requeue, do not perform the requeue and indicate that
the timed call has been aborted.

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

* mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb
(Has_Ada_Sources, Has_Foreign_Sources): new subprograms
(Project_Data.Ada_Sources_Present, Foreign_Sources_Present): removed,
since they can be computed from the above.

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

gcc/ada/ChangeLog
gcc/ada/mlib-prj.adb
gcc/ada/prj-env.adb
gcc/ada/prj-nmsc.adb
gcc/ada/prj.adb
gcc/ada/prj.ads
gcc/ada/s-tasren.adb
gcc/ada/sem_res.adb
gcc/ada/sem_warn.adb

index cf7cde3a6321fd7fac000ff0d3d6e8376df0089e..069359429066dc6977dff555dd0002f2d5fe6f9a 100644 (file)
@@ -1,3 +1,25 @@
+2009-04-24  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Resolve_Actuals): Do not create blocks around code
+       statements, even though the actual of the call is a concatenation,
+       because the argument is static, and we want to preserve warning
+       messages  about sequences of code statements that are not marked
+       volatile.
+
+       * sem_warn.adb: remove obsolete comment about warning being obsolete
+
+       * s-tasren.adb (Task_Do_Or_Queue): If a timed entry call is being
+       requeued and the delay has expired while within the accept statement
+       that executes the requeue, do not perform the requeue and indicate that
+       the timed call has been aborted.
+
+2009-04-24  Emmanuel Briot  <briot@adacore.com>
+
+       * mlib-prj.adb, prj.adb, prj.ads, prj-nmsc.adb, prj-env.adb
+       (Has_Ada_Sources, Has_Foreign_Sources): new subprograms
+       (Project_Data.Ada_Sources_Present, Foreign_Sources_Present): removed,
+       since they can be computed from the above.
+
 2009-04-24  Vincent Celier  <celier@adacore.com>
 
        * gnatcmd.adb: Call Prj.Env.Initialize with the Project_Tree
index 3256bf754917b2989e57e05e816321d4f631aeaa..b02718d6bf9b8d466da6e3234993ce28fea6117e 100644 (file)
@@ -1351,7 +1351,7 @@ package body MLib.Prj is
 
          In_Main_Object_Directory := True;
 
-         There_Are_Foreign_Sources := Data.Other_Sources_Present;
+         There_Are_Foreign_Sources := Has_Foreign_Sources (Data);
 
          loop
             if Data.Object_Directory /= No_Path_Information then
index e833d035aa0dc7c64214f637bb8b87bc725e50ad..451fcc483c97b20ce375159c7da50d62ceba8e90 100644 (file)
@@ -1563,7 +1563,7 @@ package body Prj.Env is
          --  If there are Ada sources, call action with the name of every
          --  source directory.
 
-         if In_Tree.Projects.Table (Project).Ada_Sources_Present then
+         if Has_Ada_Sources (In_Tree.Projects.Table (Project)) then
             while Current /= Nil_String loop
                The_String := In_Tree.String_Elements.Table (Current);
                Action (Get_Name_String (The_String.Display_Value));
index 14cdb0f3cd540cd5c98995a8288f72468b0c822a..7c3677b35f783983593698f5acf00cd94456cde0 100644 (file)
@@ -4348,9 +4348,6 @@ package body Prj.Nmsc is
       --  Shouldn't these be set to False by default, and only set to True when
       --  we actually find some source file???
 
-      Data.Ada_Sources_Present   := Data.Source_Dirs /= Nil_String;
-      Data.Other_Sources_Present := Data.Source_Dirs /= Nil_String;
-
       if Data.Source_Dirs /= Nil_String then
 
          --  Check if languages are specified in this project
@@ -4396,13 +4393,6 @@ package body Prj.Nmsc is
                   Data.Languages.Config.Kind := Unit_Based;
                   Data.Languages.Config.Dependency_Kind :=
                     ALI_File;
-
-                  --  Attribute Languages is not specified. So, it defaults to
-                  --  a project of language Ada only. No sources of languages
-                  --  other than Ada.
-
-                  Data.Other_Sources_Present := False;
-
                else
                   Data.Languages.Config.Kind := File_Based;
                end if;
@@ -4417,11 +4407,6 @@ package body Prj.Nmsc is
                NL_Id             : Language_Ptr;
 
             begin
-               --  Assume there are no languages declared
-
-               Data.Ada_Sources_Present := False;
-               Data.Other_Sources_Present := False;
-
                --  If there are no languages declared, there are no sources
 
                if Current = Nil_String then
@@ -4455,18 +4440,6 @@ package body Prj.Nmsc is
                      end loop;
 
                      if NL_Id = No_Language_Index then
-                        if Get_Mode = Ada_Only then
-
-                           --  Check for language Ada
-
-                           if Lang_Name = Name_Ada then
-                              Data.Ada_Sources_Present := True;
-
-                           else
-                              Data.Other_Sources_Present := True;
-                           end if;
-                        end if;
-
                         Index := new Language_Data'(No_Language_Data);
                         Index.Name := Lang_Name;
                         Index.Display_Name := Element.Value;
@@ -7096,10 +7069,6 @@ package body Prj.Nmsc is
             Name     : File_Name_Type;
 
          begin
-            if Get_Mode = Ada_Only then
-               Data.Ada_Sources_Present := Current /= Nil_String;
-            end if;
-
             if Get_Mode = Multi_Language then
                if Current = Nil_String then
                   Data.Languages := No_Language_Index;
@@ -7292,7 +7261,7 @@ package body Prj.Nmsc is
       then
          --  We should have found at least one source, if not report an error
 
-         if Data.Ada_Sources = Nil_String then
+         if not Has_Ada_Sources (Data) then
             Report_No_Sources
               (Project, "Ada", In_Tree, Source_List_File.Location);
          end if;
index e76ee8e55ddc55756e6f5ffe4e08c2d09d13b9b0..913ad888c0f58c80d3ed9e9aa2cdc193134dc43c 100644 (file)
@@ -104,8 +104,6 @@ package body Prj is
                       Lib_Auto_Init                  => False,
                       Libgnarl_Needed                => Unknown,
                       Symbol_Data                    => No_Symbols,
-                      Ada_Sources_Present            => True,
-                      Other_Sources_Present          => True,
                       Ada_Sources                    => Nil_String,
                       Interfaces_Defined             => False,
                       Imported_Directories_Switches  => null,
@@ -1184,6 +1182,42 @@ package body Prj is
       raise Constraint_Error;
    end Value;
 
+   ---------------------
+   -- Has_Ada_Sources --
+   ---------------------
+
+   function Has_Ada_Sources (Data : Project_Data) return Boolean is
+      Lang : Language_Ptr := Data.Languages;
+   begin
+      while Lang /= No_Language_Index loop
+         if Lang.Name = Name_Ada then
+            return Lang.First_Source /= No_Source;
+         end if;
+         Lang := Lang.Next;
+      end loop;
+
+      return False;
+   end Has_Ada_Sources;
+
+   -------------------------
+   -- Has_Foreign_Sources --
+   -------------------------
+
+   function Has_Foreign_Sources (Data : Project_Data) return Boolean is
+      Lang : Language_Ptr := Data.Languages;
+   begin
+      while Lang /= No_Language_Index loop
+         if Lang.Name /= Name_Ada
+           and then Lang.First_Source /= No_Source
+         then
+            return True;
+         end if;
+         Lang := Lang.Next;
+      end loop;
+
+      return False;
+   end Has_Foreign_Sources;
+
 begin
    --  Make sure that the standard config and user project file extensions are
    --  compatible with canonical case file naming.
index fb5cc0d5f908ff2d1033e11ded8fc7d3024e5f2b..88d04770b0ef611a037b5fa6ea9321daa09848a2 100644 (file)
@@ -1239,12 +1239,6 @@ package Prj is
       --  In multi-language mode, the sources for all languages including Ada
       --  are accessible through the Source_Iterator type
 
-      Ada_Sources_Present : Boolean := True;
-      --  True if there are Ada sources in the project
-
-      Other_Sources_Present : Boolean := True;
-      --  True if there are non-Ada sources in the project
-
       Ada_Sources : String_List_Id := Nil_String;
       --  The list of all the Ada source file names (gnatmake only).
 
@@ -1350,6 +1344,12 @@ package Prj is
    --  Return True when Language_Name (which must be lower case) is one of the
    --  languages used for the project.
 
+   function Has_Ada_Sources (Data : Project_Data) return Boolean;
+   --  Return True if the project has Ada sources
+
+   function Has_Foreign_Sources (Data : Project_Data) return Boolean;
+   --  Return True if the project has foreign sources
+
    Project_Error : exception;
    --  Raised by some subprograms in Prj.Attr
 
@@ -1417,8 +1417,9 @@ package Prj is
       Equal      => "=");
    --  Mapping of file names to indexes in the Units table
 
-   type Private_Project_Tree_Data is private;
-   --  Data for a project tree that is used only by the Project Manager
+   ---------------------
+   -- Source_Iterator --
+   ---------------------
 
    type Source_Iterator is private;
 
@@ -1435,6 +1436,13 @@ package Prj is
    procedure Next (Iter : in out Source_Iterator);
    --  Move on to the next source
 
+   -----------------------
+   -- Project_Tree_Data --
+   -----------------------
+
+   type Private_Project_Tree_Data is private;
+   --  Data for a project tree that is used only by the Project Manager
+
    type Project_Tree_Data is
       record
          Name_Lists        : Name_List_Table.Instance;
index 38f179d0e2e85b8101824c0605810f9290725ebb..7cdde56054d9c0adc6d7a796d8512b4f055c642b 100644 (file)
@@ -1225,9 +1225,31 @@ package body System.Tasking.Rendezvous is
       --  we would not have gotten this far, so now we should
       --  (re)enqueue the call, if the mode permits that.
 
-      if Entry_Call.Mode /= Conditional_Call
-        or else not Entry_Call.With_Abort
+      --  If the call is timed, it may have timed out before the requeue,
+      --  in the unusual case where the current accept has taken longer than
+      --  the given delay. In that case the requeue is cancelled, and the
+      --  outer timed call will be aborted.
+
+      if Entry_Call.Mode = Conditional_Call
+        or else
+          (Entry_Call.Mode = Timed_Call
+            and then Entry_Call.With_Abort
+            and then Entry_Call.Cancellation_Attempted)
       then
+         STPO.Unlock (Acceptor);
+
+         if Parent_Locked then
+            STPO.Unlock (Parent);
+         end if;
+
+         STPO.Write_Lock (Entry_Call.Self);
+
+         pragma Assert (Entry_Call.State >= Was_Abortable);
+
+         Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
+         STPO.Unlock (Entry_Call.Self);
+
+      else
          --  Timed_Call, Simple_Call, or Asynchronous_Call
 
          Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
@@ -1266,22 +1288,6 @@ package body System.Tasking.Rendezvous is
 
             STPO.Unlock (Entry_Call.Self);
          end if;
-
-      else
-         --  Conditional_Call and With_Abort
-
-         STPO.Unlock (Acceptor);
-
-         if Parent_Locked then
-            STPO.Unlock (Parent);
-         end if;
-
-         STPO.Write_Lock (Entry_Call.Self);
-
-         pragma Assert (Entry_Call.State >= Was_Abortable);
-
-         Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
-         STPO.Unlock (Entry_Call.Self);
       end if;
 
       return True;
index 4a664562a23d31f144646955cf9d6ff1274dbfe0..11bce01fe5a45126e15346c21bb238a0599c11d6 100644 (file)
@@ -3173,11 +3173,17 @@ package body Sem_Res is
             --  A small optimization: if one of the actuals is a concatenation
             --  create a block around a procedure call to recover stack space.
             --  This alleviates stack usage when several procedure calls in
-            --  the same statement list use concatenation.
+            --  the same statement list use concatenation. We do not perform
+            --  this wrapping for code statements, where the argument is a
+            --  static string, and we want to preserve warnings involving
+            --  sequences of such statements.
 
             elsif Nkind (A) = N_Op_Concat
               and then Nkind (N) = N_Procedure_Call_Statement
               and then Expander_Active
+              and then
+                not (Is_Intrinsic_Subprogram (Nam)
+                      and then Chars (Nam) = Name_Asm)
             then
                Establish_Transient_Scope (A, False);
                Resolve (A, Etype (F));
index 50c9d0c6da93873d8be2a7f998b887a0fb4c9bfd..ec1d1d767e0abe7a92f29aaf87c462249a48f23f 100644 (file)
@@ -213,16 +213,6 @@ package body Sem_Warn is
 
       --  Check multiple code statements in a row
 
-      --  Note: the following code is now unreachable, because Asm statements
-      --  are procedure calls whose actuals are concatenations, and as a result
-      --  of a recent stack usage optimization each such call has its own
-      --  block.
-
-      --  Are they always concatenations??? if so why not remove this code???
-
-      --  And indeed if we are really losing this warning, that's really bad
-      --  and we need to put it back ???
-
       if Is_List_Member (N)
         and then Present (Prev (N))
         and then Nkind (Prev (N)) = N_Code_Statement