[Bug ada/30698] New: in expand_one_stack_var_at, at cfgexpand.c:517

["karlnick at student dot chalmers dot se" <gcc-bugzilla at gcc dot gnu dot org>]

karlnick@db128:~/dns/src$ gnatmake dnsbrowse_gtk `gtkada2-config`
gcc-4.1 -c -I/usr/share/ada/adainclude/gtkada2 dnsbrowse_gtk.adb
gcc-4.1 -c -I/usr/share/ada/adainclude/gtkada2 communication.adb
+===========================GNAT BUG DETECTED==============================+
| 4.1.2 20061028 (prerelease) (Debian 4.1.1-19) (i486-pc-linux-gnu) GCC error:|
| in expand_one_stack_var_at, at cfgexpand.c:517                           |
| Error detected at communication.adb:100:8                                |
| Please submit a bug report; see http://gcc.gnu.org/bugs.html.            |
| Use a subject line meaningful to you and us to track the bug.            |
| Include the entire contents of this bug box in the report.               |
| Include the exact gcc-4.1 or gnatmake command that you entered.          |
| Also include sources listed below in gnatchop format                     |
| (concatenated together with no headers between files).                   |
+==========================================================================+

Please include these source files with error report
Note that list may not be accurate in some cases,
so please double check that the problem can still
be reproduced with the set of files listed.

communication.adb
communication.ads
dns.ads
dns-question.ads

communication.adb:17:07: warning: Storage_Error will be raised at run-time
compilation abandoned
gnatmake: "communication.adb" compilation error
karlnick@db128:~/dns/src$

with Ada.Unchecked_Conversion;
with Text_Io; use Text_Io;
with Dns.Question; use Dns.Question;
package body Communication is
      package Integer_Io is new Text_Io.Integer_Io(Integer);
      use Integer_Io;
   procedure init is
   begin
      null;
   end Init;

   procedure Send_request is
      Address  : Sock_Addr_Type;
      Channel  : Stream_Access;
      Port_Dns : Constant := 53;
      Names : Name_Type;
      Question : Question_Type;
   begin
      Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1);
      Address.Port := Port_dns;
      Names := Dns.Name("rho073.mtke.chalmers.se");

      Create_Socket(Socket);
      Connect_Socket(Socket, Address);
      Put("Nameserver ");
      Put_Line(Image(Address)); -- print the hosts ip-number:port-number
      Channel := Stream(Socket);

      Question := (Dns.Header_Type'(Id => 23,
                   Qr => Dns.Query,
                   Opcode => Dns.Query,
                   Aa => Dns.No,
                   Tc => Dns.No,
                   Rd => Dns.Yes,
                   Ra => Dns.No,
                   Z => Dns.No,
                   Rcode => Dns.No_Error,
                   others => 0),
                   Qname => Names,
                   Qtype => A,
                   Qclass => Internet);

      Put_Line("Har sänt väntar på svar");

--        declare
--           Svar : Dns_Header_Type;
--           Adresses : Octet_Array_Ptr;
--           Tmp : Octet4_Array_Ptr;
--           Tmp2 : Label_Ptr;
--        begin
--           Dns.Io.Functions.Read(Channel, Svar);
--           Put("Har fått svar");New_Line;
--           Put("id:");Put(Integer(Svar.Id));New_Line;
--           if Svar.Question /= null then
--              Put("Questions:");Put(Svar.Question'Length);New_Line;
--              for N in Svar.Question'Range loop
--                 Put(" names: ");
--                 for I in Svar.Question(N).Qname'Range loop
--                    Put(String(Svar.Question(N).Qname(I).all));Put(".");
--                 end loop;
--                 New_Line;
--              end loop;
--           end if;
--           if Svar.Answer /= null then
--              Put("answers:");Put(Svar.Answer'Length);New_Line;
--              for N in Svar.Answer'Range loop
--                 Put(" names: ");
--                 for I in Svar.Answer(N).Names'Range loop
--                    Put(String(Svar.Answer(N).Names(I).all));Put(".");
--                 end loop;
--                 Put(" ");
--                 Adresses :=
Svar.Answer(N).Rdata;Tmp:=Read_A(Svar.Answer(N));
--                 for I in Adresses'Range loop
--                    Put(Integer(Adresses(I)));Put(".");
--                 end loop;
--                 New_Line;
--              end loop;
--           end if;
--           if Svar.Authority /= null then
--              Put("Authorities:");Put(Svar.Authority'Length);New_Line;
--              for N in Svar.Authority'Range loop
--                 Put(" Authority ");
--                 for I in Svar.Authority(N).Names'Range loop
--                    Put(String(Svar.Authority(N).Names(I).all));Put(".");
--                 end loop;
--                 Put(" ");
--  --                 Tmp2:=Read_A(Svar.Authority(N));
--  --                 for I in Tmp2'Range loop
--  --                    Put(String(Tmp2(I).all));
--  --                 end loop;
--                 New_Line;
--              end loop;
--           end if;
--           if Svar.Additional /= null then
--              Put("Additionals:");Put(Svar.Additional'Length);New_Line;
--           end if;
--        end;

      Close_Socket (Socket);
   end Send_request;

   procedure Quit is
   begin
--      Put_Line("closing socket");
      null;
   end Quit;
end Communication;
with Gnat.Sockets; use Gnat.Sockets;
with Dns; use Dns;
package Communication is
   Socket   : Socket_Type;

   procedure Init;
   procedure Send_Request;
   procedure quit;
end Communication;
with System; use System;
package Dns is
   type Octet4 is range 0..2**32-1;
   for Octet4'Size use 32;

   type Octet2 is range 0..2**16-1;
   for Octet2'Size use 16;

   type Octet is range 0..2**8-1;
   for Octet'Size use 8;

   type Label_Type is private;
   function Label(L : Label_Type) return String;
   type Label_Array is array (Positive range <>) of Label_Type;

   type Name_Type is private;
   function Name(L : String) return Name_Type;
   function Name(L : Name_Type) return Label_Array;

   type Qr_Type is (Query, Response);
   type Opcode_Type is (Query, Iquery, Status);
   type Aa_Type is (No, Yes); -- Authoritative Answer
   type Tc_Type is (No, Yes); -- TrunCation
   type Rd_Type is (No, Yes); -- Recursion Desired
   type Ra_Type is (No, Yes); -- Recursion Available
   type Z_Type is (No); -- Reserved for future use.  Must be zero in all
queries and responses.
   type Rcode_Type Is (No_Error, Format_Error, Server_Failure, Name_Error,
Not_Implemented, Refused);

   --  RFC 1035        Domain Implementation and Specification    November 1987
   --  4. MESSAGES
   --  4.1. Format
   --  All communications inside of the domain protocol are carried in a single
   --  format called a message.  The top level format of message is divided
   --  into 5 sections (some of which are empty in certain cases) shown below:
   --      +---------------------+
   --      |        Header       |
   --      +---------------------+
   --      |       Question      | the question for the name server
   --      +---------------------+
   --      |        Answer       | RRs answering the question
   --      +---------------------+
   --      |      Authority      | RRs pointing toward an authority
   --      +---------------------+
   --      |      Additional     | RRs holding additional information
   --      +---------------------+
   type Header_Type is record
      -- length : octet2; added by read and write (this i is not a part of the
header)
      Id : Octet2; -- match responses to queries
      Qr : Qr_Type;         ---/-
      Opcode : Opcode_Type; -- |
      Aa : Aa_Type;         -- |
      Tc : Tc_Type;         -- |
      Rd : Rd_Type;         -- | 2 octets
      Ra : Ra_Type;         -- |
      Z : Z_Type;           -- |
      Rcode : Rcode_Type;   ---/-
      Qdcount : Octet2 := 0; -- query counter
      Ancount : Octet2 := 0; -- answer counter
      Nscount : Octet2 := 0; -- authority
      Arcount : Octet2 := 0; -- additional
                             -- Question
                             -- Answer
                             -- Authority
                             -- Additional
   end record;
   for Header_Type use record
      Id at 0 range 0..15;
      Qr at 1*2 range 0..0;      ---/-
      Opcode at 1*2 range 1..4;  -- |
      Aa at 1*2 range 5..5;      -- |
      Tc at 1*2 range 6..6;      -- | 2 octets network byte order
      Rd at 1*2 range 7..7;      -- |
      Ra at 1*2 range 8..8;      -- |
      Z at 1*2 range 9..11;      -- |
      Rcode at 1*2 range 12..15; -- /-
      Qdcount at 2*2 range 0..15;
      Ancount at 3*2 range 0..15;
      Nscount at 4*2 range 0..15;
      Arcount at 5*2 range 0..15;
   end record;
   for Header_Type'Bit_Order use High_Order_First;
private
   type Label_Type is array (Positive) of Octet;
   type Name_Type is array (Positive) of Octet;
end Dns;
package Dns.Question is

   -- RFC 1035   Domain Implementation and Specification    November 1987
   -- types and numbers Below from rfc1035.txt
   --                  TYPE                value and meaning
   type Qtype_Type is (Unknknown, -- padding begin with 0 (don't know how to
number from 1)
                       A, --               1 a host address
                       NS, --              2 an authoritative name server
                       MD, --              3 a mail destination (Obsolete - use
MX)
                       MF, --              4 a mail forwarder (Obsolete - use
MX)
                       CNAME, --           5 the canonical name for an alias
                       SOA, --             6 marks the start of a zone of
authority
                       MB, --              7 a mailbox domain name
(EXPERIMENTAL)
                       MG, --              8 a mail group member (EXPERIMENTAL)
                       MR, --              9 a mail rename domain name
(EXPERIMENTAL)
                       Unknown2, --        10 a null RR (EXPERIMENTAL)
                       WKS, --             11 a well known service description
                       PTR, --             12 a domain name pointer
                       HINFO, --           13 host information
                       MINFO, --           14 mailbox or mail list information
                       MX, --              15 mail exchange
                       TXT --              16 text strings
                      );
   for Qtype_Type'size use Octet2'size;
   -- RFC 1035   Domain Implementation and Specification    November 1987
   -- IN              1 the Internet
   -- CS              2 the CSNET class (Obsolete - used only for examples in
some obsolete RFCs)
   -- CH              3 the CHAOS class
   -- HS              4 Hesiod [Dyer 87]
   -- 3.2.5. QCLASS values
   type Qclass_type is (Internet, CS, CH, HS); -- replaced IN with internet (in
reserved keyword)
   for Qclass_type use (Internet => 1, CS => 2, CH => 3, HS => 4);
   for Qclass_type'size use Octet2'size;

   type Question_type is record
      Header : Header_Type;
      Qname : Name_Type;
      Qtype : Qtype_Type; -- machine name or mail exchanger
      Qclass : Qclass_Type;
   end record;

end Dns.Question;


-- 
           Summary: in expand_one_stack_var_at, at cfgexpand.c:517
           Product: gcc
           Version: 4.1.2
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: ada
        AssignedTo: unassigned at gcc dot gnu dot org
        ReportedBy: karlnick at student dot chalmers dot se


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=30698