[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Fri, 10 Oct 2014 14:45:27 +0000 (16:45 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 10 Oct 2014 14:45:27 +0000 (16:45 +0200)
2014-10-10  Robert Dewar  <dewar@adacore.com>

* freeze.adb, gnat1drv.adb, sem_ch13.adb: Minor reformatting and
code clean up.

2014-10-10  Hristian Kirtchev  <kirtchev@adacore.com>

* sem_res.adb (Is_OK_Volatile_Context): Allow
a volatile object reference to appear as the expression of a
type conversion.

From-SVN: r216091

gcc/ada/ChangeLog
gcc/ada/freeze.adb
gcc/ada/gnat1drv.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_res.adb

index 50e654ca3d93277e3d131cc32d96b1b831b4676f..f43c709672d968045b27ef06cc09546f9b77c022 100644 (file)
@@ -1,3 +1,14 @@
+2014-10-10  Robert Dewar  <dewar@adacore.com>
+
+       * freeze.adb, gnat1drv.adb, sem_ch13.adb: Minor reformatting and
+       code clean up.
+
+2014-10-10  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * sem_res.adb (Is_OK_Volatile_Context): Allow
+       a volatile object reference to appear as the expression of a
+       type conversion.
+
 2014-10-10  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch13.adb (Analyze_Aspect_Specifications, Library_Unit_Aspects):
index bdc2ea15e7c66e00c2184190422ac2ff7e905f93..3ae0f50516d84380cfcc1381f947167b2b703c86 100644 (file)
@@ -1857,6 +1857,13 @@ package body Freeze is
       --  Create Freeze_Generic_Entity nodes for types declared in a generic
       --  package. Recurse on inner generic packages.
 
+      function Freeze_Profile (E : Entity_Id) return Boolean;
+      --  Freeze formals and return type of subprogram.
+      --  If some type in the profile is a limited view, freezing of the entity
+      --  will take place elsewhere, and the function returns False.
+      --  This routine will be modified if and when we can implement AI05-019
+      --  efficiently.
+
       procedure Freeze_Record_Type (Rec : Entity_Id);
       --  Freeze record type, including freezing component types, and freezing
       --  primitive operations if this is a tagged type.
@@ -2681,6 +2688,341 @@ package body Freeze is
          return Flist;
       end Freeze_Generic_Entities;
 
+      --------------------
+      -- Freeze_Profile --
+      --------------------
+
+      function Freeze_Profile (E : Entity_Id) return Boolean is
+         F_Type    : Entity_Id;
+         R_Type    : Entity_Id;
+         Warn_Node : Node_Id;
+
+      begin
+         --  Loop through formals
+
+         Formal := First_Formal (E);
+         while Present (Formal) loop
+            F_Type := Etype (Formal);
+
+            --  AI05-0151: incomplete types can appear in a profile.
+            --  By the time the entity is frozen, the full view must
+            --  be available, unless it is a limited view.
+
+            if Is_Incomplete_Type (F_Type)
+              and then Present (Full_View (F_Type))
+              and then not From_Limited_With (F_Type)
+            then
+               F_Type := Full_View (F_Type);
+               Set_Etype (Formal, F_Type);
+            end if;
+
+            Freeze_And_Append (F_Type, N, Result);
+
+            if Is_Private_Type (F_Type)
+              and then Is_Private_Type (Base_Type (F_Type))
+              and then No (Full_View (Base_Type (F_Type)))
+              and then not Is_Generic_Type (F_Type)
+              and then not Is_Derived_Type (F_Type)
+            then
+               --  If the type of a formal is incomplete, subprogram
+               --  is being frozen prematurely. Within an instance
+               --  (but not within a wrapper package) this is an
+               --  artifact of our need to regard the end of an
+               --  instantiation as a freeze point. Otherwise it is
+               --  a definite error.
+
+               if In_Instance then
+                  Set_Is_Frozen (E, False);
+                  Result := No_List;
+                  return False;
+
+               elsif not After_Last_Declaration
+                 and then not Freezing_Library_Level_Tagged_Type
+               then
+                  Error_Msg_Node_1 := F_Type;
+                  Error_Msg
+                    ("type& must be fully defined before this point",
+                      Loc);
+               end if;
+            end if;
+
+            --  Check suspicious parameter for C function. These tests
+            --  apply only to exported/imported subprograms.
+
+            if Warn_On_Export_Import
+              and then Comes_From_Source (E)
+              and then (Convention (E) = Convention_C
+                          or else
+                        Convention (E) = Convention_CPP)
+              and then (Is_Imported (E) or else Is_Exported (E))
+              and then Convention (E) /= Convention (Formal)
+              and then not Has_Warnings_Off (E)
+              and then not Has_Warnings_Off (F_Type)
+              and then not Has_Warnings_Off (Formal)
+            then
+               --  Qualify mention of formals with subprogram name
+
+               Error_Msg_Qual_Level := 1;
+
+               --  Check suspicious use of fat C pointer
+
+               if Is_Access_Type (F_Type)
+                 and then Esize (F_Type) > Ttypes.System_Address_Size
+               then
+                  Error_Msg_N
+                    ("?x?type of & does not correspond to C pointer!", Formal);
+
+               --  Check suspicious return of boolean
+
+               elsif Root_Type (F_Type) = Standard_Boolean
+                 and then Convention (F_Type) = Convention_Ada
+                 and then not Has_Warnings_Off (F_Type)
+                 and then not Has_Size_Clause (F_Type)
+                 and then VM_Target = No_VM
+               then
+                  Error_Msg_N ("& is an 8-bit Ada Boolean?x?", Formal);
+                  Error_Msg_N ("\use appropriate corresponding type in C "
+                     & "(e.g. char)?x?", Formal);
+
+               --  Check suspicious tagged type
+
+               elsif (Is_Tagged_Type (F_Type)
+                       or else (Is_Access_Type (F_Type)
+                                  and then
+                                    Is_Tagged_Type
+                                      (Designated_Type (F_Type))))
+                 and then Convention (E) = Convention_C
+               then
+                  Error_Msg_N ("?x?& involves a tagged type which does not "
+                     & "correspond to any C type!", Formal);
+
+               --  Check wrong convention subprogram pointer
+
+               elsif Ekind (F_Type) = E_Access_Subprogram_Type
+                 and then not Has_Foreign_Convention (F_Type)
+               then
+                  Error_Msg_N ("?x?subprogram pointer & should "
+                     & "have foreign convention!", Formal);
+                  Error_Msg_Sloc := Sloc (F_Type);
+                  Error_Msg_NE
+                    ("\?x?add Convention pragma to declaration of &#",
+                     Formal, F_Type);
+               end if;
+
+               --  Turn off name qualification after message output
+
+               Error_Msg_Qual_Level := 0;
+            end if;
+
+            --  Check for unconstrained array in exported foreign
+            --  convention case.
+
+            if Has_Foreign_Convention (E)
+              and then not Is_Imported (E)
+              and then Is_Array_Type (F_Type)
+              and then not Is_Constrained (F_Type)
+              and then Warn_On_Export_Import
+
+              --  Exclude VM case, since both .NET and JVM can handle
+              --  unconstrained arrays without a problem.
+
+              and then VM_Target = No_VM
+            then
+               Error_Msg_Qual_Level := 1;
+
+               --  If this is an inherited operation, place the
+               --  warning on the derived type declaration, rather
+               --  than on the original subprogram.
+
+               if Nkind (Original_Node (Parent (E))) = N_Full_Type_Declaration
+               then
+                  Warn_Node := Parent (E);
+
+                  if Formal = First_Formal (E) then
+                     Error_Msg_NE
+                       ("??in inherited operation&", Warn_Node, E);
+                  end if;
+               else
+                  Warn_Node := Formal;
+               end if;
+
+               Error_Msg_NE ("?x?type of argument& is unconstrained array",
+                  Warn_Node, Formal);
+               Error_Msg_NE ("?x?foreign caller must pass bounds explicitly",
+                  Warn_Node, Formal);
+               Error_Msg_Qual_Level := 0;
+            end if;
+
+            if not From_Limited_With (F_Type) then
+               if Is_Access_Type (F_Type) then
+                  F_Type := Designated_Type (F_Type);
+               end if;
+
+               --  If the formal is an anonymous_access_to_subprogram
+               --  freeze the  subprogram type as well, to prevent
+               --  scope anomalies in gigi, because there is no other
+               --  clear point at which it could be frozen.
+
+               if Is_Itype (Etype (Formal))
+                 and then Ekind (F_Type) = E_Subprogram_Type
+               then
+                  Freeze_And_Append (F_Type, N, Result);
+               end if;
+            end if;
+
+            Next_Formal (Formal);
+         end loop;
+
+         --  Case of function: similar checks on return type
+
+         if Ekind (E) = E_Function then
+
+            --  Check whether function is declared elsewhere.
+
+            Late_Freezing :=
+              Get_Source_Unit (E) /= Get_Source_Unit (N)
+                and then Returns_Limited_View (E)
+                and then not In_Open_Scopes (Scope (E));
+
+            --  Freeze return type
+
+            R_Type := Etype (E);
+
+            --  AI05-0151: the return type may have been incomplete
+            --  at the point of declaration. Replace it with the full
+            --  view, unless the current type is a limited view. In
+            --  that case the full view is in a different unit, and
+            --  gigi finds the non-limited view after the other unit
+            --  is elaborated.
+
+            if Ekind (R_Type) = E_Incomplete_Type
+              and then Present (Full_View (R_Type))
+              and then not From_Limited_With (R_Type)
+            then
+               R_Type := Full_View (R_Type);
+               Set_Etype (E, R_Type);
+
+            --  If the return type is a limited view and the non-
+            --  limited view is still incomplete, the function has
+            --  to be frozen at a later time.
+
+            elsif Ekind (R_Type) = E_Incomplete_Type
+              and then From_Limited_With (R_Type)
+              and then
+                Ekind (Non_Limited_View (R_Type)) = E_Incomplete_Type
+            then
+               Set_Is_Frozen (E, False);
+               Set_Returns_Limited_View (E);
+               return False;
+            end if;
+
+            Freeze_And_Append (R_Type, N, Result);
+
+            --  Check suspicious return type for C function
+
+            if Warn_On_Export_Import
+              and then (Convention (E) = Convention_C
+                          or else
+                        Convention (E) = Convention_CPP)
+              and then (Is_Imported (E) or else Is_Exported (E))
+            then
+               --  Check suspicious return of fat C pointer
+
+               if Is_Access_Type (R_Type)
+                 and then Esize (R_Type) > Ttypes.System_Address_Size
+                 and then not Has_Warnings_Off (E)
+                 and then not Has_Warnings_Off (R_Type)
+               then
+                  Error_Msg_N ("?x?return type of& does not "
+                     & "correspond to C pointer!", E);
+
+               --  Check suspicious return of boolean
+
+               elsif Root_Type (R_Type) = Standard_Boolean
+                 and then Convention (R_Type) = Convention_Ada
+                 and then VM_Target = No_VM
+                 and then not Has_Warnings_Off (E)
+                 and then not Has_Warnings_Off (R_Type)
+                 and then not Has_Size_Clause (R_Type)
+               then
+                  declare
+                     N : constant Node_Id :=
+                           Result_Definition (Declaration_Node (E));
+                  begin
+                     Error_Msg_NE
+                       ("return type of & is an 8-bit Ada Boolean?x?", N, E);
+                     Error_Msg_NE
+                       ("\use appropriate corresponding type in C "
+                        & "(e.g. char)?x?", N, E);
+                  end;
+
+               --  Check suspicious return tagged type
+
+               elsif (Is_Tagged_Type (R_Type)
+                       or else (Is_Access_Type (R_Type)
+                                 and then
+                                   Is_Tagged_Type
+                                     (Designated_Type (R_Type))))
+                 and then Convention (E) = Convention_C
+                 and then not Has_Warnings_Off (E)
+                 and then not Has_Warnings_Off (R_Type)
+               then
+                  Error_Msg_N ("?x?return type of & does not "
+                     & "correspond to C type!", E);
+
+               --  Check return of wrong convention subprogram pointer
+
+               elsif Ekind (R_Type) = E_Access_Subprogram_Type
+                 and then not Has_Foreign_Convention (R_Type)
+                 and then not Has_Warnings_Off (E)
+                 and then not Has_Warnings_Off (R_Type)
+               then
+                  Error_Msg_N ("?x?& should return a foreign "
+                     & "convention subprogram pointer", E);
+                  Error_Msg_Sloc := Sloc (R_Type);
+                  Error_Msg_NE
+                    ("\?x?add Convention pragma to declaration of& #",
+                     E, R_Type);
+               end if;
+            end if;
+
+            --  Give warning for suspicious return of a result of an
+            --  unconstrained array type in a foreign convention
+            --  function.
+
+            if Has_Foreign_Convention (E)
+
+              --  We are looking for a return of unconstrained array
+
+              and then Is_Array_Type (R_Type)
+              and then not Is_Constrained (R_Type)
+
+              --  Exclude imported routines, the warning does not
+              --  belong on the import, but rather on the routine
+              --  definition.
+
+              and then not Is_Imported (E)
+
+              --  Exclude VM case, since both .NET and JVM can handle
+              --  return of unconstrained arrays without a problem.
+
+              and then VM_Target = No_VM
+
+              --  Check that general warning is enabled, and that it
+              --  is not suppressed for this particular case.
+
+              and then Warn_On_Export_Import
+              and then not Has_Warnings_Off (E)
+              and then not Has_Warnings_Off (R_Type)
+            then
+               Error_Msg_N ("?x?foreign convention function& should not " &
+                 "return unconstrained array!", E);
+            end if;
+         end if;
+
+         return True;
+      end Freeze_Profile;
+
       ------------------------
       -- Freeze_Record_Type --
       ------------------------
@@ -4009,352 +4351,12 @@ package body Freeze is
             --  reference is not a freezing point of the profile.
             --  Other constructs that should not freeze ???
 
-            if Ada_Version > Ada_2005
-              and then Nkind (N) = N_Attribute_Reference
-            then
-               null;
-
-            elsif not Is_Internal (E) then
-               declare
-                  F_Type    : Entity_Id;
-                  R_Type    : Entity_Id;
-                  Warn_Node : Node_Id;
-
-               begin
-                  --  Loop through formals
-
-                  Formal := First_Formal (E);
-                  while Present (Formal) loop
-                     F_Type := Etype (Formal);
-
-                     --  AI05-0151: incomplete types can appear in a profile.
-                     --  By the time the entity is frozen, the full view must
-                     --  be available, unless it is a limited view.
-
-                     if Is_Incomplete_Type (F_Type)
-                       and then Present (Full_View (F_Type))
-                       and then not From_Limited_With (F_Type)
-                     then
-                        F_Type := Full_View (F_Type);
-                        Set_Etype (Formal, F_Type);
-                     end if;
-
-                     Freeze_And_Append (F_Type, N, Result);
-
-                     if Is_Private_Type (F_Type)
-                       and then Is_Private_Type (Base_Type (F_Type))
-                       and then No (Full_View (Base_Type (F_Type)))
-                       and then not Is_Generic_Type (F_Type)
-                       and then not Is_Derived_Type (F_Type)
-                     then
-                        --  If the type of a formal is incomplete, subprogram
-                        --  is being frozen prematurely. Within an instance
-                        --  (but not within a wrapper package) this is an
-                        --  artifact of our need to regard the end of an
-                        --  instantiation as a freeze point. Otherwise it is
-                        --  a definite error.
-
-                        if In_Instance then
-                           Set_Is_Frozen (E, False);
-                           return No_List;
-
-                        elsif not After_Last_Declaration
-                          and then not Freezing_Library_Level_Tagged_Type
-                        then
-                           Error_Msg_Node_1 := F_Type;
-                           Error_Msg
-                             ("type& must be fully defined before this point",
-                               Loc);
-                        end if;
-                     end if;
-
-                     --  Check suspicious parameter for C function. These tests
-                     --  apply only to exported/imported subprograms.
-
-                     if Warn_On_Export_Import
-                       and then Comes_From_Source (E)
-                       and then (Convention (E) = Convention_C
-                                   or else
-                                 Convention (E) = Convention_CPP)
-                       and then (Is_Imported (E) or else Is_Exported (E))
-                       and then Convention (E) /= Convention (Formal)
-                       and then not Has_Warnings_Off (E)
-                       and then not Has_Warnings_Off (F_Type)
-                       and then not Has_Warnings_Off (Formal)
-                     then
-                        --  Qualify mention of formals with subprogram name
-
-                        Error_Msg_Qual_Level := 1;
-
-                        --  Check suspicious use of fat C pointer
-
-                        if Is_Access_Type (F_Type)
-                          and then Esize (F_Type) > Ttypes.System_Address_Size
-                        then
-                           Error_Msg_N
-                             ("?x?type of & does not correspond to C pointer!",
-                              Formal);
-
-                        --  Check suspicious return of boolean
-
-                        elsif Root_Type (F_Type) = Standard_Boolean
-                          and then Convention (F_Type) = Convention_Ada
-                          and then not Has_Warnings_Off (F_Type)
-                          and then not Has_Size_Clause (F_Type)
-                          and then VM_Target = No_VM
-                        then
-                           Error_Msg_N
-                             ("& is an 8-bit Ada Boolean?x?", Formal);
-                           Error_Msg_N
-                             ("\use appropriate corresponding type in C "
-                              & "(e.g. char)?x?", Formal);
-
-                        --  Check suspicious tagged type
-
-                        elsif (Is_Tagged_Type (F_Type)
-                                or else (Is_Access_Type (F_Type)
-                                           and then
-                                             Is_Tagged_Type
-                                               (Designated_Type (F_Type))))
-                          and then Convention (E) = Convention_C
-                        then
-                           Error_Msg_N
-                             ("?x?& involves a tagged type which does not "
-                              & "correspond to any C type!", Formal);
-
-                        --  Check wrong convention subprogram pointer
-
-                        elsif Ekind (F_Type) = E_Access_Subprogram_Type
-                          and then not Has_Foreign_Convention (F_Type)
-                        then
-                           Error_Msg_N
-                             ("?x?subprogram pointer & should "
-                              & "have foreign convention!", Formal);
-                           Error_Msg_Sloc := Sloc (F_Type);
-                           Error_Msg_NE
-                             ("\?x?add Convention pragma to declaration of &#",
-                              Formal, F_Type);
-                        end if;
-
-                        --  Turn off name qualification after message output
-
-                        Error_Msg_Qual_Level := 0;
-                     end if;
+            --  This processing doesn't apply to internal entities (see below)
 
-                     --  Check for unconstrained array in exported foreign
-                     --  convention case.
-
-                     if Has_Foreign_Convention (E)
-                       and then not Is_Imported (E)
-                       and then Is_Array_Type (F_Type)
-                       and then not Is_Constrained (F_Type)
-                       and then Warn_On_Export_Import
-
-                       --  Exclude VM case, since both .NET and JVM can handle
-                       --  unconstrained arrays without a problem.
-
-                       and then VM_Target = No_VM
-                     then
-                        Error_Msg_Qual_Level := 1;
-
-                        --  If this is an inherited operation, place the
-                        --  warning on the derived type declaration, rather
-                        --  than on the original subprogram.
-
-                        if Nkind (Original_Node (Parent (E))) =
-                          N_Full_Type_Declaration
-                        then
-                           Warn_Node := Parent (E);
-
-                           if Formal = First_Formal (E) then
-                              Error_Msg_NE
-                                ("??in inherited operation&", Warn_Node, E);
-                           end if;
-                        else
-                           Warn_Node := Formal;
-                        end if;
-
-                        Error_Msg_NE
-                          ("?x?type of argument& is unconstrained array",
-                           Warn_Node, Formal);
-                        Error_Msg_NE
-                          ("?x?foreign caller must pass bounds explicitly",
-                           Warn_Node, Formal);
-                        Error_Msg_Qual_Level := 0;
-                     end if;
-
-                     if not From_Limited_With (F_Type) then
-                        if Is_Access_Type (F_Type) then
-                           F_Type := Designated_Type (F_Type);
-                        end if;
-
-                        --  If the formal is an anonymous_access_to_subprogram
-                        --  freeze the  subprogram type as well, to prevent
-                        --  scope anomalies in gigi, because there is no other
-                        --  clear point at which it could be frozen.
-
-                        if Is_Itype (Etype (Formal))
-                          and then Ekind (F_Type) = E_Subprogram_Type
-                        then
-                           Freeze_And_Append (F_Type, N, Result);
-                        end if;
-                     end if;
-
-                     Next_Formal (Formal);
-                  end loop;
-
-                  --  Case of function: similar checks on return type
-
-                  if Ekind (E) = E_Function then
-
-                     --  Check whether function is declared elsewhere.
-
-                     Late_Freezing :=
-                       Get_Source_Unit (E) /= Get_Source_Unit (N)
-                         and then Returns_Limited_View (E)
-                         and then not In_Open_Scopes (Scope (E));
-
-                     --  Freeze return type
-
-                     R_Type := Etype (E);
-
-                     --  AI05-0151: the return type may have been incomplete
-                     --  at the point of declaration. Replace it with the full
-                     --  view, unless the current type is a limited view. In
-                     --  that case the full view is in a different unit, and
-                     --  gigi finds the non-limited view after the other unit
-                     --  is elaborated.
-
-                     if Ekind (R_Type) = E_Incomplete_Type
-                       and then Present (Full_View (R_Type))
-                       and then not From_Limited_With (R_Type)
-                     then
-                        R_Type := Full_View (R_Type);
-                        Set_Etype (E, R_Type);
-
-                     --  If the return type is a limited view and the non-
-                     --  limited view is still incomplete, the function has
-                     --  to be frozen at a later time.
-
-                     elsif Ekind (R_Type) = E_Incomplete_Type
-                       and then From_Limited_With (R_Type)
-                       and then
-                         Ekind (Non_Limited_View (R_Type)) = E_Incomplete_Type
-                     then
-                        Set_Is_Frozen (E, False);
-                        Set_Returns_Limited_View (E);
-                        return Result;
-                     end if;
-
-                     Freeze_And_Append (R_Type, N, Result);
-
-                     --  Check suspicious return type for C function
-
-                     if Warn_On_Export_Import
-                       and then (Convention (E) = Convention_C
-                                   or else
-                                 Convention (E) = Convention_CPP)
-                       and then (Is_Imported (E) or else Is_Exported (E))
-                     then
-                        --  Check suspicious return of fat C pointer
-
-                        if Is_Access_Type (R_Type)
-                          and then Esize (R_Type) > Ttypes.System_Address_Size
-                          and then not Has_Warnings_Off (E)
-                          and then not Has_Warnings_Off (R_Type)
-                        then
-                           Error_Msg_N
-                             ("?x?return type of& does not "
-                              & "correspond to C pointer!", E);
-
-                        --  Check suspicious return of boolean
-
-                        elsif Root_Type (R_Type) = Standard_Boolean
-                          and then Convention (R_Type) = Convention_Ada
-                          and then VM_Target = No_VM
-                          and then not Has_Warnings_Off (E)
-                          and then not Has_Warnings_Off (R_Type)
-                          and then not Has_Size_Clause (R_Type)
-                        then
-                           declare
-                              N : constant Node_Id :=
-                                    Result_Definition (Declaration_Node (E));
-                           begin
-                              Error_Msg_NE
-                                ("return type of & is an 8-bit Ada Boolean?x?",
-                                 N, E);
-                              Error_Msg_NE
-                                ("\use appropriate corresponding type in C "
-                                 & "(e.g. char)?x?", N, E);
-                           end;
-
-                        --  Check suspicious return tagged type
-
-                        elsif (Is_Tagged_Type (R_Type)
-                                or else (Is_Access_Type (R_Type)
-                                          and then
-                                            Is_Tagged_Type
-                                              (Designated_Type (R_Type))))
-                          and then Convention (E) = Convention_C
-                          and then not Has_Warnings_Off (E)
-                          and then not Has_Warnings_Off (R_Type)
-                        then
-                           Error_Msg_N
-                             ("?x?return type of & does not "
-                              & "correspond to C type!", E);
-
-                        --  Check return of wrong convention subprogram pointer
-
-                        elsif Ekind (R_Type) = E_Access_Subprogram_Type
-                          and then not Has_Foreign_Convention (R_Type)
-                          and then not Has_Warnings_Off (E)
-                          and then not Has_Warnings_Off (R_Type)
-                        then
-                           Error_Msg_N
-                             ("?x?& should return a foreign "
-                              & "convention subprogram pointer", E);
-                           Error_Msg_Sloc := Sloc (R_Type);
-                           Error_Msg_NE
-                             ("\?x?add Convention pragma to declaration of& #",
-                              E, R_Type);
-                        end if;
-                     end if;
-
-                     --  Give warning for suspicious return of a result of an
-                     --  unconstrained array type in a foreign convention
-                     --  function.
-
-                     if Has_Foreign_Convention (E)
-
-                       --  We are looking for a return of unconstrained array
-
-                       and then Is_Array_Type (R_Type)
-                       and then not Is_Constrained (R_Type)
-
-                       --  Exclude imported routines, the warning does not
-                       --  belong on the import, but rather on the routine
-                       --  definition.
-
-                       and then not Is_Imported (E)
-
-                       --  Exclude VM case, since both .NET and JVM can handle
-                       --  return of unconstrained arrays without a problem.
-
-                       and then VM_Target = No_VM
-
-                       --  Check that general warning is enabled, and that it
-                       --  is not suppressed for this particular case.
-
-                       and then Warn_On_Export_Import
-                       and then not Has_Warnings_Off (E)
-                       and then not Has_Warnings_Off (R_Type)
-                     then
-                        Error_Msg_N
-                          ("?x?foreign convention function& should not " &
-                           "return unconstrained array!", E);
-                     end if;
-                  end if;
-               end;
+            if not Is_Internal (E) then
+               if not Freeze_Profile (E) then
+                  return Result;
+               end if;
             end if;
 
             --  Must freeze its parent first if it is a derived subprogram
index 545d1436b3bdb6c759e1f8ba84eebb1aff70d7c7..4cbb8cb21ef660d750522059020542b4a8ad5ced 100644 (file)
@@ -585,7 +585,12 @@ procedure Gnat1drv is
 
       --  Treat -gnatn as equivalent to -gnatN for non-GCC targets
 
-      if Inline_Active and then not Front_End_Inlining then
+      if Inline_Active and not Front_End_Inlining then
+
+         --  We really should have a tag for this, what if we added a new
+         --  back end some day, it would not be true for this test, but it
+         --  would be non-GCC, so this is a bit troublesome ???
+
          Front_End_Inlining := VM_Target /= No_VM or else AAMP_On_Target;
       end if;
 
index ca11c72e37ba6c24e8c50589b43d22b58a66831c..2a3dc45405c9060af3f82daadf80c1f15cc67215 100644 (file)
@@ -3018,14 +3018,16 @@ package body Sem_Ch13 is
                   --  of a package declaration, the pragma needs to be inserted
                   --  in the list of declarations for the associated package.
                   --  There is no issue of visibility delay for these aspects.
-                  --  Aspect is legal on a local instantiation of a library-
-                  --  level generic unit.
 
                   if A_Id in Library_Unit_Aspects
                     and then
                       Nkind_In (N, N_Package_Declaration,
                                    N_Generic_Package_Declaration)
                     and then Nkind (Parent (N)) /= N_Compilation_Unit
+
+                    --  Aspect is legal on a local instantiation of a library-
+                    --  level generic unit.
+
                     and then not Is_Generic_Instance (Defining_Entity (N))
                   then
                      Error_Msg_N
index eacb977344f433ea98477776f4575cc59f0ae86c..f300e7099b39e76b2c38ba079a90592f40e2ac50 100644 (file)
@@ -6696,6 +6696,18 @@ package body Sem_Res is
          then
             return True;
 
+         --  The volatile object appears as the expression of a type conversion
+         --  occurring in a non-interfering context.
+
+         elsif Nkind_In (Context, N_Type_Conversion,
+                                  N_Unchecked_Type_Conversion)
+           and then Expression (Context) = Obj_Ref
+           and then Is_OK_Volatile_Context
+                      (Context => Parent (Context),
+                       Obj_Ref => Context)
+         then
+            return True;
+
          --  Allow references to volatile objects in various checks. This is
          --  not a direct SPARK 2014 requirement.