[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Fri, 8 Sep 2017 08:47:04 +0000 (10:47 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 8 Sep 2017 08:47:04 +0000 (10:47 +0200)
2017-09-08  Ed Schonberg  <schonberg@adacore.com>

        * sem_ch12.adb (Check_Generic_Parent): New procedure within
        Analyze_Associations, to handle actual packages that depend on
        previous instances.  If a package IAP that is an instantiation is
        used as an actual in a subsequent instantiation SI in the same
        scope, and IAP has a body, IAP must be frozen before SI. If
        the generic parent of IAP is itself declared in a previous
        instantiation in the same scope, that instantiation must also
        be frozen before SI.
        (Install_Body): Prevent double insertion of freeze node for
        instance.

2017-09-08  Hristian Kirtchev  <kirtchev@adacore.com>

        * sem_prag.adb (Resolve_State): Update the
        comment on documentation. Generate a reference to the state once
        resolution takes place.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

        * sem_ch13.adb (Analyze_Aspect_Specifications, case
        Linker_Section): If the aspect applies to an object declaration
        with explicit initialization, do not delay the freezing of the
        object, to prevent access-before-elaboration in the generated
        initialization code.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

        * a-wtdeio.adb (Put, all versions): Use Long_Long_Integer
        (Integer_Value (Item)) when the size of the fixed decimal type
        is larger than Integer.

From-SVN: r251866

gcc/ada/a-wtdeio.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_prag.adb

index 598b72a941e5e2ad99c5cc9822f7d55d119baa17..1c13f9a878b1039d8675700c44a3facbd47cb4f9 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -112,16 +112,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is
    begin
       if Num'Size > Integer'Size then
          Aux.Put_LLD
---           (TFT (File), Long_Long_Integer'Integer_Value (Item),
---  ???
-           (TFT (File), Long_Long_Integer (Item),
+           (TFT (File), Long_Long_Integer'Integer_Value (Item),
             Fore, Aft, Exp, Scale);
       else
          Aux.Put_Dec
---           (TFT (File), Integer'Integer_Value (Item), Fore, Aft, Exp, Scale);
---  ???
-           (TFT (File), Integer (Item), Fore, Aft, Exp, Scale);
-
+           (TFT (File), Integer'Integer_Value (Item), Fore, Aft, Exp, Scale);
       end if;
    end Put;
 
@@ -145,15 +140,11 @@ package body Ada.Wide_Text_IO.Decimal_IO is
 
    begin
       if Num'Size > Integer'Size then
---       Aux.Puts_LLD
---         (S, Long_Long_Integer'Integer_Value (Item), Aft, Exp, Scale);
---  ???
          Aux.Puts_LLD
-           (S, Long_Long_Integer (Item), Aft, Exp, Scale);
+           (S, Long_Long_Integer'Integer_Value (Item), Aft, Exp, Scale);
+
       else
---       Aux.Puts_Dec (S, Integer'Integer_Value (Item), Aft, Exp, Scale);
---  ???
-         Aux.Puts_Dec (S, Integer (Item), Aft, Exp, Scale);
+         Aux.Puts_Dec (S, Integer'Integer_Value (Item), Aft, Exp, Scale);
       end if;
 
       for J in S'Range loop
index f1e659c4bab1c0e29c5e5fb6d43e406db94cd25e..94bd498d74ab5e5ecec78b74fe10f1526f903ee0 100644 (file)
@@ -1908,10 +1908,40 @@ package body Sem_Ch12 is
                         Needs_Freezing : Boolean;
                         S              : Entity_Id;
 
+                        procedure Check_Generic_Parent;
+                        --  The actual may be an instantiation of a unit
+                        --  declared in a previous instantiation. If that
+                        --  one is also in the current compilation, it must
+                        --  itself be frozen before the actual.
+                        --  Should this itself be recursive ???
+
+                        --------------------------
+                        -- Check_Generic_Parent --
+                        --------------------------
+
+                        procedure Check_Generic_Parent is
+                           Par            : Entity_Id;
+                        begin
+                           if Nkind (Parent (Actual)) = N_Package_Specification
+                           then
+                              Par := Scope (Generic_Parent (Parent (Actual)));
+                              if Is_Generic_Instance (Par)
+                                and then Scope (Par) = Current_Scope
+                                and then (No (Freeze_Node (Par))
+                                  or else
+                                    not Is_List_Member (Freeze_Node (Par)))
+                              then
+                                 Set_Has_Delayed_Freeze (Par);
+                                 Append_Elmt (Par, Actuals_To_Freeze);
+                              end if;
+                           end if;
+                        end Check_Generic_Parent;
+
                      begin
                         if not Expander_Active
                           or else not Has_Completion (Actual)
                           or else not In_Same_Source_Unit (I_Node, Actual)
+                          or else Is_Frozen (Actual)
                           or else
                             (Present (Renamed_Entity (Actual))
                               and then not
@@ -1943,6 +1973,7 @@ package body Sem_Ch12 is
                            end loop;
 
                            if Needs_Freezing then
+                              Check_Generic_Parent;
                               Set_Has_Delayed_Freeze (Actual);
                               Append_Elmt (Actual, Actuals_To_Freeze);
                            end if;
@@ -9281,7 +9312,10 @@ package body Sem_Ch12 is
       --  if no delay is needed, we place the freeze node at the end of the
       --  current declarative part.
 
-      if Expander_Active then
+      if Expander_Active
+        and then (No (Freeze_Node (Act_Id))
+          or else not Is_List_Member (Freeze_Node (Act_Id)))
+      then
          Ensure_Freeze_Node (Act_Id);
          F_Node := Freeze_Node (Act_Id);
 
index 20619964bd2ebda595d90700088c7f41a4369994..90b629ce92601157984724dcdd76ff1f3e4d6905 100644 (file)
@@ -2208,6 +2208,20 @@ package body Sem_Ch13 is
                          Expression => Relocate_Node (Expr))),
                      Pragma_Name                  => Chars (Id));
 
+                  --  Linker_Section does not need delaying, as its argument
+                  --  must be a static string. Furthermore, if applied to
+                  --  an object with an explicit initialization, the object
+                  --  must be frozen in order to elaborate the initialization
+                  --  code. (This is already done for types with implicit
+                  --  initialization, such as protected types.)
+
+                  if A_Id = Aspect_Linker_Section
+                    and then Nkind (N) = N_Object_Declaration
+                    and then Has_Init_Expression (N)
+                  then
+                     Delay_Required := False;
+                  end if;
+
                --  Synchronization
 
                --  Corresponds to pragma Implemented, construct the pragma
index 9cf91556922f54f973a6e4a8bf4e9745babd2582..2f6b2306f6012215574f0a4e7592b2952da19092 100644 (file)
@@ -283,9 +283,9 @@ package body Sem_Prag is
    --  reference for future checks (see Analyze_Refined_State_In_Decls).
 
    procedure Resolve_State (N : Node_Id);
-   --  Handle the overloading of state names by functions. When N denotes a
-   --  function, this routine finds the corresponding state and sets the entity
-   --  of N to that of the state.
+   --  Handle the overloading of state names by parameterless functions. When N
+   --  denotes a function, this routine finds the corresponding state and sets
+   --  the entity of N to that of the state.
 
    procedure Rewrite_Assertion_Kind
      (N           : Node_Id;
@@ -30229,16 +30229,20 @@ package body Sem_Prag is
          --  homonym chain looking for an abstract state.
 
          if Ekind (Func) = E_Function and then Has_Homonym (Func) then
+            pragma Assert (Is_Overloaded (N));
+
             State := Homonym (Func);
             while Present (State) loop
+               if Ekind (State) = E_Abstract_State then
 
-               --  Resolve the overloading by setting the proper entity of the
-               --  reference to that of the state.
+                  --  Resolve the overloading by setting the proper entity of
+                  --  the reference to that of the state.
 
-               if Ekind (State) = E_Abstract_State then
-                  Set_Etype           (N, Standard_Void_Type);
-                  Set_Entity          (N, State);
-                  Set_Associated_Node (N, State);
+                  Set_Etype         (N, Standard_Void_Type);
+                  Set_Entity        (N, State);
+                  Set_Is_Overloaded (N, False);
+
+                  Generate_Reference (State, N);
                   return;
                end if;