[multiple changes]
authorPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 16 Nov 2017 09:56:46 +0000 (09:56 +0000)
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>
Thu, 16 Nov 2017 09:56:46 +0000 (09:56 +0000)
2017-11-16  Ed Schonberg  <schonberg@adacore.com>

* sem_ch3.adb (Process_Subtype): If the subtype indication does not
syntactically denote a type, return Any_Type to prevent subsequent
compiler crashes or infinite loops.

2017-11-16  Steve Baird  <baird@adacore.com>

* lib-writ.adb: Fix bug which causes Program_Error to be raised in some
cases when writing out a .ali file when a Rename_Pragma pragma is in
effect.
* lib-writ.adb (Write_Unit_Information): Replace call to
Pragma_Name_Unmapped with call to Pragma_Name.

2017-11-16  Gary Dismukes  <dismukes@adacore.com>

* sem_elab.adb: Minor typo fixes.

2017-11-16  Justin Squirek  <squirek@adacore.com>

* sem_res.adb (Resolve_Allocator): Correct warning messages and make
them more explicit.

From-SVN: r254803

gcc/ada/ChangeLog
gcc/ada/lib-writ.adb
gcc/ada/sem_ch3.adb
gcc/ada/sem_elab.adb
gcc/ada/sem_res.adb

index b18c46f..58291de 100644 (file)
@@ -1,3 +1,26 @@
+2017-11-16  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch3.adb (Process_Subtype): If the subtype indication does not
+       syntactically denote a type, return Any_Type to prevent subsequent
+       compiler crashes or infinite loops.
+
+2017-11-16  Steve Baird  <baird@adacore.com>
+
+       * lib-writ.adb: Fix bug which causes Program_Error to be raised in some
+       cases when writing out a .ali file when a Rename_Pragma pragma is in
+       effect.
+       * lib-writ.adb (Write_Unit_Information): Replace call to
+       Pragma_Name_Unmapped with call to Pragma_Name.
+
+2017-11-16  Gary Dismukes  <dismukes@adacore.com>
+
+       * sem_elab.adb: Minor typo fixes.
+
+2017-11-16  Justin Squirek  <squirek@adacore.com>
+
+       * sem_res.adb (Resolve_Allocator): Correct warning messages and make
+       them more explicit.
+
 2017-11-16  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * atree.ads (Nkind_In): Add 10 and 11 parameter versions.
index addc9a0..1ee329e 100644 (file)
@@ -694,7 +694,7 @@ package body Lib.Writ is
                   Write_Info_Initiate ('N');
                   Write_Info_Char (' ');
 
-                  case Pragma_Name_Unmapped (N) is
+                  case Pragma_Name (N) is
                      when Name_Annotate =>
                         C := 'A';
                      when Name_Comment =>
index 2c75337..5ff3ed1 100644 (file)
@@ -21338,6 +21338,16 @@ package body Sem_Ch3 is
 
       if Nkind (S) /= N_Subtype_Indication then
          Find_Type (S);
+
+         --  No way to proceed if the subtype indication is malformed.
+         --  This will happen for example when the subtype indication in
+         --  an object declaration is missing altogether and the expression
+         --  is analyzed as if it were that indication.
+
+         if not Is_Entity_Name (S) then
+            return Any_Type;
+         end if;
+
          Check_Incomplete (S);
          P := Parent (S);
 
index 8c5611c..1217a2c 100644 (file)
@@ -775,7 +775,7 @@ package body Sem_Elab is
    --  Obtain the hash value of entity Key
 
    Early_Call_Regions_In_Use : Boolean := False;
-   --  This flag flag determines whether table Early_Call_Regions contains at
+   --  This flag determines whether table Early_Call_Regions contains at least
    --  least one key/value pair.
 
    Early_Call_Regions_No_Element : constant Node_Id := Empty;
@@ -953,7 +953,7 @@ package body Sem_Elab is
 
    procedure Check_SPARK_Scenario (N : Node_Id);
    pragma Inline (Check_SPARK_Scenario);
-   --  Top level dispatcher for verifying SPARK scenarios which are not always
+   --  Top-level dispatcher for verifying SPARK scenarios which are not always
    --  executable during elaboration but still need elaboration-related checks.
 
    procedure Check_SPARK_Refined_State_Pragma (N : Node_Id);
@@ -1463,7 +1463,7 @@ package body Sem_Elab is
       --  Perform ABE checks and diagnostics for task activation call Call
       --  which activates task Obj_Id. Call_Attrs are the attributes of the
       --  activation call. Task_Attrs are the attributes of the task type.
-      --  The flags should be set when the processing was initated as follows:
+      --  The flags should be set when the processing was initiated as follows:
       --
       --    In_Init_Cond   - initial condition procedure
       --    In_Partial_Fin - partial finalization procedure
@@ -2274,7 +2274,7 @@ package body Sem_Elab is
       end loop;
 
       --  Examine each SPARK scenario saved during the Recording phase which
-      --  isnot necessarily executable during elaboration, but still requires
+      --  is not necessarily executable during elaboration, but still requires
       --  elaboration-related checks.
 
       for Index in SPARK_Scenarios.First .. SPARK_Scenarios.Last loop
@@ -2602,8 +2602,8 @@ package body Sem_Elab is
          --  The suggestion applies only when the subprogram body resides in a
          --  compilation package body, and a pragma Elaborate_Body would allow
          --  for the node to appear in the early call region of the subprogram
-         --  body. This implies that all code from the subprogram body upto the
-         --  node is preelaborable.
+         --  body. This implies that all code from the subprogram body up to
+         --  the node is preelaborable.
 
          if Nkind (Unt) = N_Package_Body then
 
@@ -2618,7 +2618,7 @@ package body Sem_Elab is
                  Assume_Elab_Body => True,
                  Skip_Memoization => True);
 
-            --  If the node appears within the early call region assuming that
+            --  If the node appears within the early call region, assuming that
             --  the package spec carries pragma Elaborate_Body, then it is safe
             --  to suggest the pragma.
 
index 024b879..84f19a7 100644 (file)
@@ -5156,32 +5156,14 @@ package body Sem_Res is
                --  of coextensions properly so let's at least warn the user
                --  about it.
 
-               if Is_Controlled_Active (Desig_T) then
-                  if Is_Controlled_Active
-                       (Defining_Identifier
-                         (Parent (Associated_Node_For_Itype (Typ))))
-                  then
-                     Error_Msg_N
-                       ("??coextension will not be finalized when its "
-                        & "associated owner is finalized", N);
-                  else
-                     Error_Msg_N
-                       ("??coextension will not be finalized when its "
-                        & "associated owner is deallocated", N);
-                  end if;
+               if Is_Controlled (Desig_T) then
+                  Error_Msg_N
+                    ("??coextension will not be finalized when its "
+                     & "associated owner is deallocated or finalized", N);
                else
-                  if Is_Controlled_Active
-                       (Defining_Identifier
-                          (Parent (Associated_Node_For_Itype (Typ))))
-                  then
-                     Error_Msg_N
-                       ("??coextension will not be deallocated when "
-                        & "its associated owner is finalized", N);
-                  else
-                     Error_Msg_N
-                       ("??coextension will not be deallocated when "
-                        & "its associated owner is deallocated", N);
-                  end if;
+                  Error_Msg_N
+                    ("??coextension will not be deallocated when its "
+                     & "associated owner is deallocated", N);
                end if;
             end if;
 
@@ -5200,8 +5182,10 @@ package body Sem_Res is
               and then Is_Controlled_Active (Desig_T)
             then
                Error_Msg_N
-                 ("??anonymous access-to-controlled object will be finalized "
-                  & "when its enclosing unit goes out of scope", N);
+                 ("??object designated by anonymous access object might not "
+                  & "be finalized until its enclosing library unit goes out "
+                  & "of scope", N);
+               Error_Msg_N ("\use named access type instead", N);
             end if;
          end if;
       end if;