]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
2015-10-26 Ed Schonberg <schonberg@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 26 Oct 2015 11:37:17 +0000 (11:37 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 26 Oct 2015 11:37:17 +0000 (11:37 +0000)
* sem_disp.adb (Check_Controlling_Type): Handle properly the
case of an incomplete type whose full view is tagged, when a
primitive operation of the type is declared between the two views.

2015-10-26  Bob Duff  <duff@adacore.com>

* adaint.c (__gnat_locate_exec_on_path): If the PATH environment
variable is not set, do not return NULL, because we can still find
the executable if it includes a directory name.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

* sem_elab.adb (Elab_Warning): Under dynamic elaboration, when
elaboration warnings are enabled, emit proper warning header
when triggered by an access attribute.

2015-10-26  Steve Baird  <baird@adacore.com>

* exp_ch11.adb: If CodePeer_Mode is true, generate simplified
SCIL for exception declarations.
* exp_ch11.adb (Expand_N_Exception_Declaration) If CodePeer_Mode
is True, initialize the Full_Name component of the exception
record to null instead of to the result of an unchecked
conversion.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

* exp_unst.adb (Note_Uplevel_Ref) : Handle properly a reference
that denotes a function returning a constrained array, that has
been rewritten as a procedure.
* makeutl.ads: Minor edit.

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

gcc/ada/ChangeLog
gcc/ada/adaint.c
gcc/ada/exp_ch11.adb
gcc/ada/exp_unst.adb
gcc/ada/makeutl.ads
gcc/ada/sem_disp.adb
gcc/ada/sem_elab.adb

index 61abaee34f953e910be0650c9308f2f326fe360e..4c3620f9cedc20782beaba40e4d53d209b7e0ab9 100644 (file)
@@ -1,3 +1,37 @@
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_disp.adb (Check_Controlling_Type): Handle properly the
+       case of an incomplete type whose full view is tagged, when a
+       primitive operation of the type is declared between the two views.
+
+2015-10-26  Bob Duff  <duff@adacore.com>
+
+       * adaint.c (__gnat_locate_exec_on_path): If the PATH environment
+       variable is not set, do not return NULL, because we can still find
+       the executable if it includes a directory name.
+
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_elab.adb (Elab_Warning): Under dynamic elaboration, when
+       elaboration warnings are enabled, emit proper warning header
+       when triggered by an access attribute.
+
+2015-10-26  Steve Baird  <baird@adacore.com>
+
+       * exp_ch11.adb: If CodePeer_Mode is true, generate simplified
+       SCIL for exception declarations.
+       * exp_ch11.adb (Expand_N_Exception_Declaration) If CodePeer_Mode
+       is True, initialize the Full_Name component of the exception
+       record to null instead of to the result of an unchecked
+       conversion.
+
+2015-10-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_unst.adb (Note_Uplevel_Ref) : Handle properly a reference
+       that denotes a function returning a constrained array, that has
+       been rewritten as a procedure.
+       * makeutl.ads: Minor edit.
+
 2015-10-26  Yannick Moy  <moy@adacore.com>
 
        * lib-xref-spark_specific.adb (Traverse_Protected_Declaration): New
index 6e18d9433fed1d65243438ef928c4fc9f6351e6a..59032470365977843d5b29c15d97f084f0b9dc22 100644 (file)
@@ -2787,16 +2787,19 @@ __gnat_locate_exec_on_path (char *exec_name)
   apath_val = (char *) alloca (EXPAND_BUFFER_SIZE);
 
   WS2SC (apath_val, wapath_val, EXPAND_BUFFER_SIZE);
-  return __gnat_locate_exec (exec_name, apath_val);
 
 #else
   char *path_val = getenv ("PATH");
 
-  if (path_val == NULL) return NULL;
+  /* If PATH is not defined, proceed with __gnat_locate_exec anyway, so we can
+     find files that contain directory names.  */
+
+  if (path_val == NULL) path_val = "";
   apath_val = (char *) alloca (strlen (path_val) + 1);
   strcpy (apath_val, path_val);
-  return __gnat_locate_exec (exec_name, apath_val);
 #endif
+
+  return __gnat_locate_exec (exec_name, apath_val);
 }
 
 /* Dummy functions for Osint import for non-VMS systems.
index 9580d2dd15fcc4c918b4e3fda5a094242e537ac5..814dfdd80fde13bbb0d71928e0ec26b8f5db5887 100644 (file)
@@ -1288,10 +1288,18 @@ package body Exp_Ch11 is
 
       --  Full_Name component: Standard.A_Char!(Nam'Address)
 
-      Append_To (L, Unchecked_Convert_To (Standard_A_Char,
-        Make_Attribute_Reference (Loc,
-          Prefix         => New_Occurrence_Of (Ex_Id, Loc),
-          Attribute_Name => Name_Address)));
+      --  The unchecked conversion causes capacity issues for CodePeer in some
+      --  cases and is never useful, so we set the Full_Name component to null
+      --  instead for CodePeer.
+
+      if CodePeer_Mode then
+         Append_To (L, Make_Null (Loc));
+      else
+         Append_To (L, Unchecked_Convert_To (Standard_A_Char,
+           Make_Attribute_Reference (Loc,
+             Prefix         => New_Occurrence_Of (Ex_Id, Loc),
+             Attribute_Name => Name_Address)));
+      end if;
 
       --  HTable_Ptr component: null
 
index 1bea872aaf791e289c25e5604b96c884f9163482..0b738d1b45030d2706eeb3fd409567147dc62090 100644 (file)
@@ -466,6 +466,16 @@ package body Exp_Unst is
 
                if Caller = Callee then
                   return;
+
+               --  Callee may be a function that returns an array, and
+               --  that has been rewritten as a procedure. If caller is
+               --  that procedure, nothing to do either.
+
+               elsif Ekind (Callee) = E_Function
+                 and then Rewritten_For_C (Callee)
+                 and then Next_Entity (Callee) = Caller
+               then
+                  return;
                end if;
 
                --  We have a new uplevel referenced entity
index 185569bca195d29f213579f47d8c9f7fa23d8e3f..c13a151dcb28a15b7ea6c4a6ac20ddb9509c5a0d 100644 (file)
@@ -476,7 +476,7 @@ package Makeutl is
 
       function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
       --  Returns the number of mains in this project tree (if Tree is null, it
-      --  returns the total number of project trees)
+      --  returns the total number of project trees).
 
       procedure Fill_From_Project
         (Root_Project : Project_Id;
index 74a315dd3f2d967fed76b55b1f7fb7bbd49ca194..d2396a37465a6e0f6bcef00a0893685d5299a49f 100644 (file)
@@ -316,6 +316,18 @@ package body Sem_Disp is
             Tagged_Type := Base_Type (T);
          end if;
 
+      --  If the type is incomplete, it may have been declared without a
+      --  Tagged indication, but the full view may be tagged, in which case
+      --  that is the controlling type of the subprogram. This is one of the
+      --  approx. 579 places in the language where a lookahead would help.
+
+      elsif Ekind (T) = E_Incomplete_Type
+        and then Present (Full_View (T))
+        and then Is_Tagged_Type (Full_View (T))
+      then
+         Set_Is_Tagged_Type (T);
+         Tagged_Type := Full_View (T);
+
       elsif Ekind (T) = E_Anonymous_Access_Type
         and then Is_Tagged_Type (Designated_Type (T))
       then
@@ -595,14 +607,17 @@ package body Sem_Disp is
                     and then Is_Entity_Name (Name (Par))
                   then
                      declare
+                        Enc_Subp : constant Entity_Id := Entity (Name (Par));
                         A : Node_Id;
                         F : Entity_Id;
 
                      begin
-                        --  Find formal for which call is the actual.
+                        --  Find formal for which call is the actual, and is
+                        --  a controlling argument.
 
-                        F := First_Formal (Entity (Name (Par)));
+                        F := First_Formal (Enc_Subp);
                         A := First_Actual (Par);
+
                         while Present (F) loop
                            if Is_Controlling_Formal (F)
                              and then (N = A or else Parent (N) = A)
@@ -697,11 +712,11 @@ package body Sem_Disp is
          --  If the call doesn't have a controlling actual but does have an
          --  indeterminate actual that requires dispatching treatment, then an
          --  object is needed that will serve as the controlling argument for
-         --  a dispatching call on the indeterminate actual. This can only
-         --  occur in the unusual situation of a default actual given by
-         --  a tag-indeterminate call and where the type of the call is an
-         --  ancestor of the type associated with a containing call to an
-         --  inherited operation (see AI-239).
+         --  a dispatching call on the indeterminate actual. This can occur
+         --  in the unusual situation of a default actual given by a tag-
+         --  indeterminate call and where the type of the call is an ancestor
+         --  of the type associated with a containing call to an inherited
+         --  operation (see AI-239).
 
          --  Rather than create an object of the tagged type, which would
          --  be problematic for various reasons (default initialization,
@@ -849,6 +864,7 @@ package body Sem_Disp is
          end if;
 
       else
+
          --  If dispatching on result, the enclosing call, if any, will
          --  determine the controlling argument. Otherwise this is the
          --  primitive operation of the root type.
index 1f60e2d16098aec596e4a0377666d49544c3ee85..b206682ab0a6c5eaaf454eb7bf007c8b5029b63e 100644 (file)
@@ -548,6 +548,12 @@ package body Sem_Elab is
                if Msg_D /= "" and then Elab_Warnings then
                   Error_Msg_NE (Msg_D, N, Ent);
                end if;
+
+            --  In the access case emit first warning message as well,
+            --  otherwise list of calls will appear as errors.
+
+            elsif Elab_Warnings then
+               Error_Msg_NE (Msg_S, N, Ent);
             end if;
 
          --  Static elaboration checks, info message