[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Wed, 19 Feb 2014 14:42:55 +0000 (15:42 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 19 Feb 2014 14:42:55 +0000 (15:42 +0100)
2014-02-19  Ed Schonberg  <schonberg@adacore.com>

* sem_prag.adb (Check_Arg_Is_Local_Name): For an aspect that
applies to a subprogram body, the name is the current scope,
rather than being declared in the current scope.
(Analyze_Pragma, case No_Return): Handle properly a No_Return
aspect applied to a subprogram body.

2014-02-19  Ed Schonberg  <schonberg@adacore.com>

* sem_ch13.adb (Resolve_Iterable_Operation): Improve resolution
of overloaded subprograms, and fix bug in handling of primitive
operation Element.

2014-02-19  Pascal Obry  <obry@adacore.com>

* s-os_lib.adb: Minor reformatting.

2014-02-19  Yannick Moy  <moy@adacore.com>

* expander.adb (Expand): Do nothing inside generics.
* sem_aggr.adb (Aggregate_Constraint_Checks): Do nothing inside
generics.

2014-02-19  Yannick Moy  <moy@adacore.com>

* exp_ch2.adb: Remove useless 'with' of unit Uintp.

From-SVN: r207901

gcc/ada/ChangeLog
gcc/ada/exp_ch2.adb
gcc/ada/expander.adb
gcc/ada/s-os_lib.adb
gcc/ada/sem_aggr.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_prag.adb

index c25c5a5..583e37e 100644 (file)
@@ -1,3 +1,31 @@
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_prag.adb (Check_Arg_Is_Local_Name): For an aspect that
+       applies to a subprogram body, the name is the current scope,
+       rather than being declared in the current scope.
+       (Analyze_Pragma, case No_Return): Handle properly a No_Return
+       aspect applied to a subprogram body.
+
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch13.adb (Resolve_Iterable_Operation): Improve resolution
+       of overloaded subprograms, and fix bug in handling of primitive
+       operation Element.
+
+2014-02-19  Pascal Obry  <obry@adacore.com>
+
+       * s-os_lib.adb: Minor reformatting.
+
+2014-02-19  Yannick Moy  <moy@adacore.com>
+
+       * expander.adb (Expand): Do nothing inside generics.
+       * sem_aggr.adb (Aggregate_Constraint_Checks): Do nothing inside
+       generics.
+
+2014-02-19  Yannick Moy  <moy@adacore.com>
+
+       * exp_ch2.adb: Remove useless 'with' of unit Uintp.
+
 2014-02-19  Robert Dewar  <dewar@adacore.com>
 
        * sem_ch3.adb, style.adb, sem_prag.adb, sem_ch13.adb: Minor reformatting
index de3bbbc..2abbd25 100644 (file)
@@ -44,7 +44,6 @@ with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Snames;   use Snames;
 with Tbuild;   use Tbuild;
-with Uintp;    use Uintp;
 
 package body Exp_Ch2 is
 
index 9f57cda..65e8a67 100644 (file)
@@ -90,7 +90,8 @@ package body Expander is
       --  analysis, in which case Full_Analysis = True or a pre-analysis in
       --  which case Full_Analysis = False. See the spec of Sem for more info
       --  on this. Additionally, the GNATprove_Mode flag indicates that a light
-      --  expansion for formal verification should be used.
+      --  expansion for formal verification should be used. This expansion is
+      --  never done inside generics.
 
       --  The second reason for the Expander_Active flag to be False is that
       --  we are performing a pre-analysis. During pre-analysis all expansion
@@ -108,7 +109,9 @@ package body Expander is
       --  given that the expansion actions that would normally process it will
       --  not take place. This prevents cascaded errors due to stack mismatch.
 
-      if not (Expander_Active or (Full_Analysis and GNATprove_Mode)) then
+      if not Expander_Active
+        and (Inside_A_Generic or not Full_Analysis or not GNATprove_Mode)
+      then
          Set_Analyzed (N, Full_Analysis);
 
          if Serious_Errors_Detected > 0 and then Scope_Is_Transient then
index dc51fa1..fa44b52 100644 (file)
@@ -2643,11 +2643,11 @@ package body System.OS_Lib is
          end loop;
 
          if Blocking then
-            Pid     := Invalid_Pid;
-            Result  := Portable_Spawn (Arg_List'Address);
+            Pid    := Invalid_Pid;
+            Result := Portable_Spawn (Arg_List'Address);
          else
-            Pid     := Portable_No_Block_Spawn (Arg_List'Address);
-            Result  := Boolean'Pos (Pid /= Invalid_Pid);
+            Pid    := Portable_No_Block_Spawn (Arg_List'Address);
+            Result := Boolean'Pos (Pid /= Invalid_Pid);
          end if;
       end Spawn;
 
index 6ba4c12..81beb71 100644 (file)
@@ -459,7 +459,9 @@ package body Sem_Aggr is
       --  added in the tree, so that the formal verification can rely on those
       --  to be present.
 
-      if not (Expander_Active or GNATprove_Mode) or In_Spec_Expression then
+      if not Expander_Active
+        and (Inside_A_Generic or not Full_Analysis or not GNATprove_Mode)
+      then
          return;
       end if;
 
index 70cf819..a55899c 100644 (file)
@@ -10975,6 +10975,14 @@ package body Sem_Ch13 is
             end if;
 
          elsif Nam = Name_Element then
+            F2 := Next_Formal (F1);
+
+            if No (F2)
+              or else Etype (F2) /= Cursor
+              or else Present (Next_Formal (F2))
+            then
+               Error_Msg_N ("no match for Element iterable primitive", N);
+            end if;
             null;
 
          else
@@ -10993,6 +11001,7 @@ package body Sem_Ch13 is
             Get_First_Interp (N, I, It);
             while Present (It.Typ) loop
                if Ekind (It.Nam) = E_Function
+                  and then Scope (It.Nam) = Scope (Typ)
                   and then Etype (First_Formal (It.Nam)) = Typ
                then
                   F1 := First_Formal (It.Nam);
@@ -11031,6 +11040,8 @@ package body Sem_Ch13 is
                      end if;
 
                   elsif Nam = Name_Element then
+                     F2 := Next_Formal (F1);
+
                      if Present (F2)
                        and then No (Next_Formal (F2))
                        and then Etype (F2) = Cursor
index 21514bf..ed8df6e 100644 (file)
@@ -3888,6 +3888,16 @@ package body Sem_Prag is
                           Generic_Formal_Declarations
                             (Unit_Declaration_Node (Scop));
 
+               --  If this is an aspect applied to a subprogram body, the
+               --  pragma is inserted in its declarative part.
+
+               elsif From_Aspect_Specification (N)
+                 and then
+                   Nkind (Unit_Declaration_Node (Ent)) = N_Subprogram_Body
+                 and then  Ent = Current_Scope
+               then
+                  OK := True;
+
                --  Default case, just check that the pragma occurs in the scope
                --  of the entity denoted by the name.
 
@@ -16671,8 +16681,17 @@ package body Sem_Prag is
                   E := Homonym (E);
                end loop;
 
+               --  If entity in not in current scope it may be the enclosing
+               --  suprogram body to which the aspect applies.
+
                if not Found then
-                  Error_Pragma_Arg ("no procedure & found for pragma%", Arg);
+                  if Entity (Id) = Current_Scope
+                    and then From_Aspect_Specification (N)
+                  then
+                     Set_No_Return (Entity (Id));
+                  else
+                     Error_Pragma_Arg ("no procedure& found for pragma%", Arg);
+                  end if;
                end if;
 
                Next (Arg);