2011-08-29 Vincent Celier <celier@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 29 Aug 2011 13:48:36 +0000 (13:48 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 29 Aug 2011 13:48:36 +0000 (13:48 +0000)
* make.adb (Scan_Make_Arg): Take any option as is in packages Compiler,
Binder or Linker of the main project file.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

* inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic
unit.

2011-08-29  Yannick Moy  <moy@adacore.com>

* exp_ch9.adb: Partial revert of previous change for Alfa mode

2011-08-29  Yannick Moy  <moy@adacore.com>

* exp_ch11.adb: Minor expansion of comment.

2011-08-29  Yannick Moy  <moy@adacore.com>

* lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

* sem_res.adb (Resolve_Arithmetic_Op): If the node has a universal
interpretation, set the type before resolving the operands, because
legality checks on an exponention operand need to know the type of the
context.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

* sem_ch12.adb (Analyze_Package_Instantiation): Do not set delayed
cleanups on a master if the instance is within a generic unit.
Complement to the corresponding fix to inline.adb for K520-030.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

* exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current
occurrence.
* exp_intr.adb: Minor comment fix.

2011-08-29  Bob Duff  <duff@adacore.com>

* sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where
Delay_Required was used as an uninitialized variable.

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

gcc/ada/ChangeLog
gcc/ada/exp_ch11.adb
gcc/ada/exp_ch7.adb
gcc/ada/exp_ch9.adb
gcc/ada/exp_intr.adb
gcc/ada/inline.adb
gcc/ada/lib-xref-alfa.adb
gcc/ada/make.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_res.adb

index 1a078d5..42da6ae 100644 (file)
@@ -1,3 +1,49 @@
+2011-08-29  Vincent Celier  <celier@adacore.com>
+
+       * make.adb (Scan_Make_Arg): Take any option as is in packages Compiler,
+       Binder or Linker of the main project file.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+       * inline.adb (Add_Scopes_To_Clean): Exclude any entity within a generic
+       unit.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+       * exp_ch9.adb: Partial revert of previous change for Alfa mode
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+       * exp_ch11.adb: Minor expansion of comment.
+
+2011-08-29  Yannick Moy  <moy@adacore.com>
+
+       * lib-xref-alfa.adb (Add_ALFA_Scope): Treat generic entities.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_res.adb (Resolve_Arithmetic_Op): If the node has a universal
+       interpretation, set the type before resolving the operands, because
+       legality checks on an exponention operand need to know the type of the
+       context.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch12.adb (Analyze_Package_Instantiation): Do not set delayed
+       cleanups on a master if the instance is within a generic unit.
+       Complement to the corresponding fix to inline.adb for K520-030.
+
+2011-08-29  Tristan Gingold  <gingold@adacore.com>
+
+       * exp_ch7.adb (Build_Raise_Statement): Raise PE instead of the current
+       occurrence.
+       * exp_intr.adb: Minor comment fix.
+
+2011-08-29  Bob Duff  <duff@adacore.com>
+
+       * sem_ch13.adb (Analyze_Aspect_Specifications): Fix cases where
+       Delay_Required was used as an uninitialized variable.
+
 2011-08-29  Robert Dewar  <dewar@adacore.com>
 
        * a-cdlili.adb, a-cdlili.ads, a-coinve.adb, a-coinve.ads,
index 8b391d5..caf66cc 100644 (file)
@@ -1667,7 +1667,9 @@ package body Exp_Ch11 is
       else
          --  Bypass expansion to a run-time call when back-end exception
          --  handling is active, unless the target is a VM, CodePeer or
-         --  GNATprove.
+         --  GNATprove. In CodePeer, raising an exception is treated as an
+         --  error, while in GNATprove all code with exceptions falls outside
+         --  the subset of code which can be formally analyzed.
 
          if VM_Target = No_VM
            and then not CodePeer_Mode
index 2dc78e9..984bdb8 100644 (file)
@@ -3104,24 +3104,35 @@ package body Exp_Ch7 is
       E_Id      : Entity_Id;
       Raised_Id : Entity_Id) return Node_Id
    is
-      Proc_Id : Entity_Id;
+      Stmt : Node_Id;
 
    begin
       --  Standard run-time, .NET/JVM targets
+      --  Call Raise_From_Controlled_Operation (E_Id).
 
       if RTE_Available (RE_Raise_From_Controlled_Operation) then
-         Proc_Id := RTE (RE_Raise_From_Controlled_Operation);
+         Stmt :=
+           Make_Procedure_Call_Statement (Loc,
+              Name                   =>
+                New_Reference_To (RTE (RE_Raise_From_Controlled_Operation),
+                                  Loc),
+              Parameter_Associations =>
+                New_List (New_Reference_To (E_Id, Loc)));
 
       --  Restricted runtime: exception messages are not supported and hence
       --  Raise_From_Controlled_Operation is not supported.
+      --  Simply raise Program_Error.
 
       else
-         Proc_Id := RTE (RE_Reraise_Occurrence);
+         Stmt :=
+           Make_Raise_Program_Error (Loc,
+             Reason => PE_Finalize_Raised_Exception);
+
       end if;
 
       --  Generate:
       --    if Raised_Id and then not Abort_Id then
-      --       <Proc_Id> (<Params>);
+      --       Raise_From_Controlled_Operation (E_Id);
       --    end if;
 
       return
@@ -3133,11 +3144,7 @@ package body Exp_Ch7 is
                 Make_Op_Not (Loc,
                   Right_Opnd => New_Reference_To (Abort_Id, Loc))),
 
-          Then_Statements => New_List (
-            Make_Procedure_Call_Statement (Loc,
-              Name                   => New_Reference_To (Proc_Id, Loc),
-              Parameter_Associations =>
-                New_List (New_Reference_To (E_Id, Loc)))));
+          Then_Statements => New_List (Stmt));
    end Build_Raise_Statement;
 
    -----------------------------
index b57f3d6..57193cb 100644 (file)
@@ -4878,6 +4878,12 @@ package body Exp_Ch9 is
       Ldecl2 : Node_Id;
 
    begin
+      --  In formal verification mode, do not expand tasking constructs
+
+      if ALFA_Mode then
+         return;
+      end if;
+
       if Expander_Active then
 
          --  If we have no handled statement sequence, we may need to build
@@ -10571,12 +10577,6 @@ package body Exp_Ch9 is
       Decl_Stack : Node_Id;
 
    begin
-      --  Do not expand tasking constructs in formal verification mode
-
-      if ALFA_Mode then
-         return;
-      end if;
-
       --  If already expanded, nothing to do
 
       if Present (Corresponding_Record_Type (Tasktyp)) then
index ce05b42..7ce12d6 100644 (file)
@@ -1232,7 +1232,7 @@ package body Exp_Intr is
 
       --  Generate:
       --    if Raised and then not Abort then
-      --       Reraise_Occurrence (E);               --  for .NET and
+      --       raise Program_Error;                  --  for .NET and
       --                                             --  restricted RTS
       --         <or>
       --       Raise_From_Controlled_Operation (E);  --  all other cases
index ec534e1..0eb8dce 100644 (file)
@@ -496,8 +496,10 @@ package body Inline is
          return;
       end if;
 
-      --  If the instance appears within a generic subprogram there is nothing
-      --  to finalize either.
+      --  If the instance is within a generic unit, no finalization code
+      --  can be generated. Note that at this point all bodies have been
+      --  analyzed, and the scope stack itself is not present, and the flag
+      --  Inside_A_Generic is not set.
 
       declare
          S : Entity_Id;
@@ -505,7 +507,7 @@ package body Inline is
       begin
          S := Scope (Inst);
          while Present (S) and then S /= Standard_Standard loop
-            if Is_Generic_Subprogram (S) then
+            if Is_Generic_Unit (S) then
                return;
             end if;
 
index 75dea7f..9aabe7c 100644 (file)
@@ -282,10 +282,10 @@ package body ALFA is
       end if;
 
       case Ekind (E) is
-         when E_Function =>
+         when E_Function | E_Generic_Function =>
             Typ := 'V';
 
-         when E_Procedure =>
+         when E_Procedure | E_Generic_Procedure =>
             Typ := 'U';
 
          when E_Subprogram_Body =>
@@ -308,7 +308,7 @@ package body ALFA is
                end if;
             end;
 
-         when E_Package | E_Package_Body =>
+         when E_Package | E_Package_Body | E_Generic_Package =>
             Typ := 'K';
 
          when E_Void =>
index ce12020..c7e1d07 100644 (file)
@@ -7373,15 +7373,15 @@ package body Make is
 
          end if;
 
-      --  Then check if we are dealing with -cargs/-bargs/-largs/-margs
-
-      elsif Argv = "-bargs"
-              or else
-            Argv = "-cargs"
-              or else
-            Argv = "-largs"
-              or else
-            Argv = "-margs"
+      --  Then check if we are dealing with -cargs/-bargs/-largs/-margs. These
+      --  options are taken as is when found in package Compiler, Binder or
+      --  Linker of the main project file.
+
+      elsif (And_Save or else Program_Args = None)
+        and then (Argv = "-bargs" or else
+                  Argv = "-cargs" or else
+                  Argv = "-largs" or else
+                  Argv = "-margs")
       then
          case Argv (2) is
             when 'c' => Program_Args := Compiler;
index 6f0b049..8df2d05 100644 (file)
@@ -3528,15 +3528,13 @@ package body Sem_Ch12 is
                            Enclosing_Master := Scope (Enclosing_Master);
                         end if;
 
-                     elsif Ekind (Enclosing_Master) = E_Generic_Package then
-                        Enclosing_Master := Scope (Enclosing_Master);
-
-                     elsif Is_Generic_Subprogram (Enclosing_Master)
+                     elsif Is_Generic_Unit (Enclosing_Master)
                        or else Ekind (Enclosing_Master) = E_Void
                      then
                         --  Cleanup actions will eventually be performed on the
-                        --  enclosing instance, if any. Enclosing scope is void
-                        --  in the formal part of a generic subprogram.
+                        --  enclosing subprogram or package instance, if any.
+                        --  Enclosing scope is void in the formal part of a
+                        --  generic subprogram.
 
                         exit Scope_Loop;
 
index fcece69..5113904 100644 (file)
@@ -710,7 +710,7 @@ package body Sem_Ch13 is
       --  or attribute definition node in either case to activate special
       --  processing (e.g. not traversing the list of homonyms for inline).
 
-      Delay_Required : Boolean;
+      Delay_Required : Boolean := False;
       --  Set True if delay is required
 
    begin
@@ -904,7 +904,7 @@ package body Sem_Ch13 is
 
                   --  Never need to delay for boolean aspects
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Library unit aspects. These are boolean aspects, but we
                --  have to do special things with the insertion, since the
@@ -944,7 +944,7 @@ package body Sem_Ch13 is
 
                   --  If not package declaration, no delay is required
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Aspects related to container iterators. These aspects denote
                --  subprograms, and thus must be delayed.
@@ -1046,7 +1046,8 @@ package body Sem_Ch13 is
                   --  to take care of it right away.
 
                   if Nkind_In (Expr, N_Integer_Literal, N_String_Literal) then
-                     Delay_Required := False;
+                     pragma Assert (not Delay_Required);
+                     null;
                   else
                      Delay_Required := True;
                      Set_Is_Delayed_Aspect (Aspect);
@@ -1073,7 +1074,7 @@ package body Sem_Ch13 is
                   --  We don't have to play the delay game here, since the only
                   --  values are check names which don't get analyzed anyway.
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Aspects corresponding to pragmas with two arguments, where
                --  the second argument is a local name referring to the entity,
@@ -1095,7 +1096,7 @@ package body Sem_Ch13 is
                   --  We don't have to play the delay game here, since the only
                   --  values are ON/OFF which don't get analyzed anyway.
 
-                  Delay_Required := False;
+                  pragma Assert (not Delay_Required);
 
                --  Default_Value and Default_Component_Value aspects. These
                --  are specially handled because they have no corresponding
@@ -1146,6 +1147,8 @@ package body Sem_Ch13 is
 
                   Set_From_Aspect_Specification (Aitem, True);
 
+                  pragma Assert (not Delay_Required);
+
                when Aspect_Priority | Aspect_Interrupt_Priority => declare
                   Pname : Name_Id;
 
@@ -1164,6 +1167,8 @@ package body Sem_Ch13 is
                         New_List (Relocate_Node (Expr)));
 
                   Set_From_Aspect_Specification (Aitem, True);
+
+                  pragma Assert (not Delay_Required);
                end;
 
                --  Aspects Pre/Post generate Precondition/Postcondition pragmas
@@ -1523,7 +1528,7 @@ package body Sem_Ch13 is
                            Prepend (Aitem, To => L);
                         end;
 
-                  --  For all other cases, insert in sequence
+                     --  For all other cases, insert in sequence
 
                      when others =>
                         Insert_After (Ins_Node, Aitem);
index 86c6d3e..433678a 100644 (file)
@@ -4640,13 +4640,16 @@ package body Sem_Res is
       --  universal real, since in this case we don't do a conversion to a
       --  specific fixed-point type (instead the expander handles the case).
 
+      --  Set the type of the node to its universal interpretation because
+      --  legality checks on an exponentiation operand need the context.
+
       elsif (B_Typ = Universal_Integer or else B_Typ = Universal_Real)
         and then Present (Universal_Interpretation (L))
         and then Present (Universal_Interpretation (R))
       then
+         Set_Etype (N, B_Typ);
          Resolve (L, Universal_Interpretation (L));
          Resolve (R, Universal_Interpretation (R));
-         Set_Etype (N, B_Typ);
 
       elsif (B_Typ = Universal_Real
               or else Etype (N) = Universal_Fixed